sig2dot/sig2dot

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