]> git.somenet.org - pub/jan/scripts.git/blob - sig2dot.pl
ingress autorecharger.
[pub/jan/scripts.git] / sig2dot.pl
1 #!/usr/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
74 use strict;
75
76 my $version = "0.35";
77
78 my $chartchar = "*";
79 my $renderdate = "";
80 my ($stats, $color, $all, $not_found, $revokestr);
81
82 use Getopt::Std;
83 my %opt;
84 getopts('d:u:r:s:bahqv', \%opt);
85
86 sub version {
87   print <<EOT;
88 sig2dot $version
89 Copyright (c) 2002 Darxus\@ChaosReigns.com
90 Copyright (c) 2005 Christoph Berg <cb\@df7cb.de>
91 EOT
92 }
93
94 if ($opt{h}) {
95   version();
96   print <<EOT;
97 gpg --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.
107 EOT
108   exit 0;
109 }
110 if ($opt{v}) {
111   version();
112   exit 0;
113 }
114
115 if ($opt{d}) { 
116   $renderdate = $opt{d}; 
117   print STDERR "Printing from date: $renderdate.\n";
118   $renderdate =~ s/\D+//g;
119 }
120 if ($opt{s}) { 
121   $stats = $opt{s}; 
122   print STDERR "Print statistics to $stats.\n";
123 }
124 if ($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 }
132 if ($opt{a}) {
133   $all = 1;
134 } else {
135   $all = 0;
136 }
137
138 if ($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
144 if ($opt{r}) {
145   $revokestr = lc $opt{r};
146 } else {
147   $revokestr = "[revoked"; # this changed from gpg 1.2 -> 1.4
148 }
149
150 my ($owner, %name, %revlist, %sigstmp, %signedbytmp, @names, %revs);
151
152 while (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
239 my (%sigs, %signedby);
240
241 for 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
259 print "digraph \"debian-keyring\" {\noverlap=scale\nsplines=true\nsep=.1\n";
260
261 my %saw;
262 @saw{@names} = ();
263 @names = keys %saw;
264 undef %saw;
265
266 my $maxsigcount = 0;
267 my (%sigcount);
268
269 for 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
288 my %signedbycount;
289 my ($maxsignedbycount, $maxratio) = (0, 0);
290
291 for 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 }
305 print "//$maxratio\n";
306
307 if ($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
320 print "node [style=filled]\n";
321 for 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
349 for 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
359 print "}\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
363 sub 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 }
396 sub maxof {
397    my ($a, $b) = @_;
398
399    return $a>$b?$a:$b;
400 }
401 sub minof {
402    my ($a, $b) = @_;
403
404    return $a<$b?$a:$b;
405 }
406
407 # vim:sw=2: