1#!/usr/local/bin/perl -w
2
3# sig2dot v0.29 (c) Darxus@ChaosReigns.com, released under the GPL
4# Download from: http://www.chaosreigns.com/code/sig2dot/
5# sig2dot v0.35 (c) 2005 Christoph Berg <cb@df7cb.de>
6# Download from: http://ftp.debian.org/debian/pool/main/s/sig2dot/
7#
8# Parses output of "gpg --list-sigs" into a format
9# suitable for rendering into a graph by graphviz
10# (http://www.research.att.com/sw/tools/graphviz/) like so:
11#
12# $ gpg --list-sigs --keyring ./phillylinux.gpg | ./sig2dot.pl > phillylinux.dot
13# $ neato -Tps phillylinux.dot > phillylinux.ps
14# $ convert phillylinux.ps phillylinux.jpg
15#
16# Commandline options:
17#
18# -b
19#   Black and white / do not colorize.
20#
21# -d <date>
22#   Render graph as it appeared on <date> (ignores more recent
23#   signatures).  Date must be in the format "YYYY-MM-DD".
24#   Will also ignore keys that have since been revoked.
25#
26# -a
27#   Render all keys, even if they're not signed by any other key.
28#
29# -u <"string">
30#   Support localized output of GnuPG for unknown user IDs. For
31#   example, German users have to write (with sh quotation marks!)
32#   "[User-ID nicht gefunden]" if they use GnuPG with German
33#   messages. Default is "[User id not found]".
34#
35# -r <"string">
36#   Support localized output of GnuPG for revoked keys. For
37#   example, French users have to write "révoqué" if they use
38#   GnuPG with French messages. Default is "[revoked".
39#
40# -s stats.html
41#   Produces statistics file with number of signatures per node
42#
43# -h  print help
44# -v  print version
45# -q  be quiet
46#
47# Changes:
48#
49# v0.9 2000-09-14 19:20  strip trailing whitespace from $id more cleanly
50# v0.10 2000-09-14 19:33 skip revoked keys at the request of Peter Palfrader <ppalfrad@cosy.sbg.ac.at>
51# v0.11 Nov 22 21:38     use ID for node name instead of username for uniqueness
52# v0.12 Dec 15 16:20 use names instead of IDs again in stats.html
53# v0.13 Jun 19 03:15 red is proportional to signatures
54# v0.14 Jun 19 03:25 blue is proportional to other keys signed
55# v0.15 Jun 20 17:16 fixed blue, green is proportional to ratio
56# v0.16 Jun 20 18:55 uniqed %signedby
57# v0.17 Jan 10 19:10 Use overlap=scale instead of fixed edge lengths.  Requires new version of graphviz.
58# v0.18 Jan 23 11:53 stats.html is now valid html (v.01 transitional)
59# v0.23 May  3 18:52 bunch of new stuff, including -b flag (black & white), and fixes devision by zero error
60# v0.24 May  3 18:59 add black outline to nodes, prettier (changed node attribute "color" to "fillcolor")
61# v0.25 May  3 19:06 cleaned up anti- devision by zero code a little
62# v0.26 May  4 00:08 strip all non-digit characters from $renderdate
63# v0.27 May 10 00:23:49 2002 use {}'s to write 1 line per public key instead of one line per signature (much shorter)
64# v0.28 Feb 13 2003 Change regex to handle option trust digit
65#                   <kevin@rosenberg.net>
66# v0.29 Feb 18 2003 Add -s option to optionally produce statistics file
67#                   <kevin@rosenberg.net>
68# v0.30 Feb 18 2003 Make --list-sigs regex more robust
69#                   Marco Bodrato <bodrato@gulp.linux.it>
70# v0.31 Jul 28 2003 Add -u option for localized output of GnuPG
71#                   Marcus Frings <protagonist@gmx.net>
72# further changes are documented in debian/changelog
73
74use strict;
75
76my $version = "0.35";
77
78my $chartchar = "*";
79my $renderdate = "";
80my ($stats, $color, $all, $not_found, $revokestr);
81
82use Getopt::Std;
83my %opt;
84getopts('d:u:r:s:bahqv', \%opt);
85
86sub version {
87  print <<EOT;
88sig2dot $version
89Copyright (c) 2002 Darxus\@ChaosReigns.com
90Copyright (c) 2005 Christoph Berg <cb\@df7cb.de>
91EOT
92}
93
94if ($opt{h}) {
95  version();
96  print <<EOT;
97gpg --list-sigs | $0 [-abdhqsuv] > sigs.dot
98-a              Graph all keys, even if they do not have a signature
99-b              Black and white / do not colorize.
100-d YYYY-MM-DD   Render graph as it appeared on date.
101-h              Print this help and exit.
102-q              Be quiet.
103-r sting        key-is-revoked string (default: "[revoked").
104-s stats.html   Produces statistics file with number of signatures per node.
105-u string       user-id-not-found string (default: "[user id not found]").
106-v              Print version and exit.
107EOT
108  exit 0;
109}
110if ($opt{v}) {
111  version();
112  exit 0;
113}
114
115if ($opt{d}) {
116  $renderdate = $opt{d};
117  print STDERR "Printing from date: $renderdate.\n";
118  $renderdate =~ s/\D+//g;
119}
120if ($opt{s}) {
121  $stats = $opt{s};
122  print STDERR "Print statistics to $stats.\n";
123}
124if ($opt{b})
125{
126  $color = 0;
127  print STDERR "Black and White.\n" unless $opt{q};
128} else {
129  $color = 1;
130  print STDERR "Color.\n" unless $opt{q};
131}
132if ($opt{a}) {
133  $all = 1;
134} else {
135  $all = 0;
136}
137
138if ($opt{u}) {
139  $not_found = lc $opt{u};
140} else {
141  $not_found = "[user id not found]"; # this changed from gpg 1.2 -> 1.4
142}
143
144if ($opt{r}) {
145  $revokestr = lc $opt{r};
146} else {
147  $revokestr = "[revoked"; # this changed from gpg 1.2 -> 1.4
148}
149
150my ($owner, %name, %revlist, %sigstmp, %signedbytmp, @names, %revs);
151
152while (my $line = <>)
153{
154  chomp $line;
155
156# gpg 1.2
157#pub  1024D/807CAC25 2003-08-01 Michael Ablassmeier (abi) <abi#grinser.de>
158#sig         B3B2A12C 2004-01-28   [User id not found]
159#sig 3       9456ADE2 2004-02-07   Michael Schiansky <michael#schiansky.de>
160# gpg 1.4:
161#pub   1024D/807CAC25 2003-08-01
162#uid                  Michael Ablassmeier (abi) <abi#grinser.de>
163#sig          B3B2A12C 2004-01-28  [User ID not found]
164#sig 3        9456ADE2 2004-02-07  Michael Schiansky <michael#schiansky.de>
165
166                 # type                          id       date       name
167   if ($line =~ m#([\w]+)[ !\?][ \dLNPRX]{0,8} +([^ ]+) +([^ ]+)(?: +"?([^<"]*))?#)
168# differences:
169# " " -> "[ !\?]" (to use 'gpg --check-sigs|sig2dot.mio|springgraph|display')
170# "[ \d]" -> "[ \dLRXP]" (signature attributes)
171# "[^<]+" -> "[^<]*" (to recognise "pub" lines whitout a name)
172#  if ($line =~ m#([\w]+) [ \d]? +([^ ]+) +([^ ]+) +([^<]+)#)
173#  if ($line =~ m#([\w]+) +([^ ]+) +([^ ]+) +([^<]+)#)
174
175  {
176    my $type = $1;
177    my $id = $2;
178    my $date = $3;
179    my $name = $4 || "";
180
181    $date =~ tr/-//d;
182    if ($type eq "pub" or $renderdate eq "" or $date <= $renderdate)
183    {
184      print STDERR "Using: $line\n" unless $opt{q};
185      # strip trailing whitespace more cleanly:
186      $name =~ s/\s+$//g;
187
188      #Remove re: http://bugs.debian.org/202484
189      #$name =~ s/[^a-zA-Z \.0-9]/_/g; # handle non-7bit names
190
191      if ($type eq "pub")
192      {
193        $id = (split('/',$id))[1];
194        $owner = $id;
195      }
196
197      # remove comment field
198      $name{$id} = (split ' \(', $name)[0] if $name; # gpg 1.4 fixup
199
200      # skip revoked keys
201      if (index($name, $revokestr) >= 0) {
202        $revlist{$id} = 1;
203        next;
204      }
205
206      if ($type eq "uid") {
207	$name{$owner} = $id; # gpg 1.4 fixup
208      }
209
210#      unless (defined @{$sigs{$owner}})
211#      {
212#        @{$sigs{$owner}} = ();
213#      }
214      if ($type eq "sig" and lc $name ne $not_found)
215      {
216	if ($id ne $owner) {
217	  push (@{$sigstmp{$owner}},$id);
218	  push (@{$signedbytmp{$id}},$owner);
219	}
220	if ($all or $id ne $owner) {
221	  push (@names,$id,$owner);
222	}
223      }
224      if ($type eq "rev" and lc $name ne $not_found)
225      {
226	if ($id ne $owner) {
227	  push (@{$revs{$owner}},$id);
228	  #push (@{$revokedby{$id}},$owner);
229	}
230      }
231    } else {
232      print STDERR "Skipping due to date: $line\n";
233    }
234  } else {
235    print STDERR "Skipping due to regex: $line\n" if $line ne "";
236  }
237}
238
239my (%sigs, %signedby);
240
241for my $id (sort {$sigstmp{$a} <=> $sigstmp{$b}} keys %sigstmp) {
242  next if (defined $revlist{$id});
243  foreach my $owner (@{$signedbytmp{$id}}) {
244    next if (defined $revlist{$owner});
245    my $revoke = 0;
246    foreach my $revid (@{$revs{$owner}}) {
247      if ($revid eq $id) {
248        $revoke = 1;
249      }
250    }
251    #$res = $revlist{$id};
252    if (($revoke == 0)) {
253      push (@{$sigs{$owner}},$id);
254      push (@{$signedby{$id}},$owner);
255    }
256  }
257}
258
259print "digraph \"debian-keyring\" {\noverlap=scale\nsplines=true\nsep=.1\n";
260
261my %saw;
262@saw{@names} = ();
263@names = keys %saw;
264undef %saw;
265
266my $maxsigcount = 0;
267my (%sigcount);
268
269for my $owner (sort {$sigs{$a} <=> $sigs{$b}} keys %sigs)
270{
271  undef %saw;
272  @saw{@{$sigs{$owner}}} = ();
273  @{$sigs{$owner}} = keys %saw;
274  undef %saw;
275  undef %saw;
276  $signedby{$owner} ||= [];
277  @saw{@{$signedby{$owner}}} = ();
278  @{$signedby{$owner}} = keys %saw;
279  undef %saw;
280
281  $sigcount{$owner} = scalar(@{$sigs{$owner}});
282  if ($sigcount{$owner} > $maxsigcount)
283  {
284    $maxsigcount = $sigcount{$owner};
285  }
286}
287
288my %signedbycount;
289my ($maxsignedbycount, $maxratio) = (0, 0);
290
291for my $owner (sort {$signedby{$a} <=> $signedby{$b}} keys %signedby)
292{
293  $signedbycount{$owner} = scalar(@{$signedby{$owner}});
294  if ($signedbycount{$owner} > $maxsignedbycount)
295  {
296    $maxsignedbycount = $signedbycount{$owner};
297  }
298  if ($sigcount{$owner} and $sigcount{$owner} > 0) {
299    if ($signedbycount{$owner} / $sigcount{$owner} > $maxratio)
300    {
301      $maxratio = $signedbycount{$owner} / $sigcount{$owner};
302    }
303  }
304}
305print "//$maxratio\n";
306
307if ($stats) {
308    open (STATS,">$stats");
309    print STATS "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n<html><head><title>Keyring Statistics</title></head><body><table border=1>\n";
310
311    for my $owner (sort {$sigcount{$b} <=> $sigcount{$a}} keys %sigs)
312    {
313	print STATS "<tr><td>$name{$owner}<td>$sigcount{$owner}<td><img src=\"/images/pipe0.jpg\" height=15 width=",$sigcount{$owner} * 20," alt=\"". $chartchar x $sigcount{$owner} ."\">\n";
314    }
315
316    print STATS "</table></body></html>\n";
317    close STATS;
318}
319
320print "node [style=filled]\n";
321for my $id (@names)
322{
323  if ((not exists $sigcount{$id}) and (not exists $signedbycount{$id}) and not $all) {
324    next;
325  }
326  if ($color)
327  {
328    my ($red, $green, $blue) = (0, 1/3, 1/3);
329    if ($sigcount{$id}) {
330      $red = $sigcount{$id} / $maxsigcount;
331    }
332    if ($sigcount{$id} && $maxratio != 0)
333    {
334      $green = ($signedbycount{$id} / $sigcount{$id} / $maxratio * .75) * 2/3 + 1/3;
335    }
336    if ($signedbycount{$id} and $maxsignedbycount != 0) {
337      $blue = ($signedbycount{$id} / $maxsignedbycount) * 2/3 + 1/3;
338    }
339
340    my ($hue,$saturation,$value) = rgb2hsv($red,$green,$blue);
341    printf "//%d %d $red,$green,$blue\n", $sigcount{$id} || 0, $signedbycount{$id} || 0;
342    print "\"$id\" [fillcolor=\"$hue,$saturation,$value\",label=\"$name{$id}\"]\n";
343  } else {
344    print "\"$id\" [label=\"$name{$id}\"]\n";
345  }
346}
347#print "node [style=solid]\n";
348
349for my $owner (sort keys %sigs)
350{
351 print "{ ";
352  for my $id (@{$sigs{$owner}})
353  {
354    print "\"$id\" ";
355  }
356  print "} -> \"$owner\"\n";
357}
358
359print "}\n";
360
361#  Converts rgb to hsv.  All numbers are within range 0 to 1
362#  from http://twiki.org/cgi-bin/view/Codev/WebMap
363sub rgb2hsv {
364    my ($r, $g ,$b) = @_;
365    my $max = maxof($r, maxof($g, $b));
366    my $min = minof($r, minof($g, $b));
367    my $v = $max;
368    my ($s, $h);
369
370    if ($max > 0.0) {
371        $s = ($max - $min) / $max;
372    } else {
373        $s = 0;
374    }
375    if ($s > 0.0) {
376        my ($rc, $gc, $bc, $diff);
377            $diff = $max - $min;
378        $rc = ($max - $r) / $diff;
379        $gc = ($max - $g) / $diff;
380        $bc = ($max - $b) / $diff;
381        if ($r == $max) {
382            $h = ($bc - $gc) / 6.0;
383        } elsif ($g == $max) {
384            $h = (2.0 + $rc - $bc) / 6.0;
385        } else {
386            $h = (4.0 + $gc - $rc) / 6.0;
387        }
388    } else {
389       $h = 0.0;
390    }
391    if ($h < 0.0) {
392       $h += 1.0;
393    }
394    return ($h, $s, $v);
395}
396sub maxof {
397   my ($a, $b) = @_;
398
399   return $a>$b?$a:$b;
400}
401sub minof {
402   my ($a, $b) = @_;
403
404   return $a<$b?$a:$b;
405}
406
407# vim:sw=2:
408