summaryrefslogtreecommitdiff
path: root/parabola-keyring/sig2dot.pl
blob: d59a86c168824fbbb064c547c9e8537597e65f4e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
#!/usr/bin/perl -w

# sig2dot v0.29 (c) Darxus@ChaosReigns.com, released under the GPL
# Download from: http://www.chaosreigns.com/code/sig2dot/
# sig2dot v0.35 (c) 2005 Christoph Berg <cb@df7cb.de>
# Download from: http://ftp.debian.org/debian/pool/main/s/sig2dot/
#
# Parses output of "gpg --list-sigs" into a format
# suitable for rendering into a graph by graphviz 
# (http://www.research.att.com/sw/tools/graphviz/) like so:
#
# $ gpg --list-sigs --keyring ./phillylinux.gpg | ./sig2dot.pl > phillylinux.dot
# $ neato -Tps phillylinux.dot > phillylinux.ps
# $ convert phillylinux.ps phillylinux.jpg
#
# Commandline options:
#
# -b  
#   Black and white / do not colorize.
#
# -d <date>
#   Render graph as it appeared on <date> (ignores more recent
#   signatures).  Date must be in the format "YYYY-MM-DD".
#   Will also ignore keys that have since been revoked.
#
# -a
#   Render all keys, even if they're not signed by any other key.
#
# -u <"string">
#   Support localized output of GnuPG for unknown user IDs. For
#   example, German users have to write (with sh quotation marks!)
#   "[User-ID nicht gefunden]" if they use GnuPG with German
#   messages. Default is "[User id not found]".
#
# -r <"string">
#   Support localized output of GnuPG for revoked keys. For
#   example, French users have to write "révoqué" if they use
#   GnuPG with French messages. Default is "[revoked".
#
# -s stats.html
#   Produces statistics file with number of signatures per node
#
# -h  print help
# -v  print version
# -q  be quiet
#
# Changes:
#
# v0.9 2000-09-14 19:20  strip trailing whitespace from $id more cleanly
# v0.10 2000-09-14 19:33 skip revoked keys at the request of Peter Palfrader <ppalfrad@cosy.sbg.ac.at>
# v0.11 Nov 22 21:38     use ID for node name instead of username for uniqueness
# v0.12 Dec 15 16:20 use names instead of IDs again in stats.html
# v0.13 Jun 19 03:15 red is proportional to signatures
# v0.14 Jun 19 03:25 blue is proportional to other keys signed
# v0.15 Jun 20 17:16 fixed blue, green is proportional to ratio
# v0.16 Jun 20 18:55 uniqed %signedby
# v0.17 Jan 10 19:10 Use overlap=scale instead of fixed edge lengths.  Requires new version of graphviz.
# v0.18 Jan 23 11:53 stats.html is now valid html (v.01 transitional)
# v0.23 May  3 18:52 bunch of new stuff, including -b flag (black & white), and fixes devision by zero error
# v0.24 May  3 18:59 add black outline to nodes, prettier (changed node attribute "color" to "fillcolor")
# v0.25 May  3 19:06 cleaned up anti- devision by zero code a little
# v0.26 May  4 00:08 strip all non-digit characters from $renderdate
# 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)
# v0.28 Feb 13 2003 Change regex to handle option trust digit 
#                   <kevin@rosenberg.net>
# v0.29 Feb 18 2003 Add -s option to optionally produce statistics file 
#                   <kevin@rosenberg.net>
# v0.30 Feb 18 2003 Make --list-sigs regex more robust 
#                   Marco Bodrato <bodrato@gulp.linux.it>
# v0.31 Jul 28 2003 Add -u option for localized output of GnuPG
#                   Marcus Frings <protagonist@gmx.net>
# further changes are documented in debian/changelog

use strict;

my $version = "0.35";

my $chartchar = "*";
my $renderdate = "";
my ($stats, $color, $all, $not_found, $revokestr);

use Getopt::Std;
my %opt;
getopts('d:u:r:s:bahqv', \%opt);

sub version {
  print <<EOT;
sig2dot $version
Copyright (c) 2002 Darxus\@ChaosReigns.com
Copyright (c) 2005 Christoph Berg <cb\@df7cb.de>
EOT
}

if ($opt{h}) {
  version();
  print <<EOT;
gpg --list-sigs | $0 [-abdhqsuv] > sigs.dot
-a              Graph all keys, even if they do not have a signature
-b              Black and white / do not colorize.
-d YYYY-MM-DD   Render graph as it appeared on date.
-h              Print this help and exit.
-q              Be quiet.
-r sting        key-is-revoked string (default: "[revoked").
-s stats.html   Produces statistics file with number of signatures per node.
-u string       user-id-not-found string (default: "[user id not found]").
-v              Print version and exit.
EOT
  exit 0;
}
if ($opt{v}) {
  version();
  exit 0;
}

if ($opt{d}) { 
  $renderdate = $opt{d}; 
  print STDERR "Printing from date: $renderdate.\n";
  $renderdate =~ s/\D+//g;
}
if ($opt{s}) { 
  $stats = $opt{s}; 
  print STDERR "Print statistics to $stats.\n";
}
if ($opt{b}) 
{ 
  $color = 0; 
  print STDERR "Black and White.\n" unless $opt{q};
} else { 
  $color = 1; 
  print STDERR "Color.\n" unless $opt{q};
}
if ($opt{a}) {
  $all = 1;
} else {
  $all = 0;
}

if ($opt{u}) {
  $not_found = lc $opt{u};
} else {
  $not_found = "[user id not found]"; # this changed from gpg 1.2 -> 1.4
}

if ($opt{r}) {
  $revokestr = lc $opt{r};
} else {
  $revokestr = "[revoked"; # this changed from gpg 1.2 -> 1.4
}

my ($owner, %name, %revlist, %sigstmp, %signedbytmp, @names, %revs);

while (my $line = <>)
{
  chomp $line;

# gpg 1.2
#pub  1024D/807CAC25 2003-08-01 Michael Ablassmeier (abi) <abi#grinser.de>
#sig         B3B2A12C 2004-01-28   [User id not found]
#sig 3       9456ADE2 2004-02-07   Michael Schiansky <michael#schiansky.de>
# gpg 1.4:
#pub   1024D/807CAC25 2003-08-01
#uid                  Michael Ablassmeier (abi) <abi#grinser.de>
#sig          B3B2A12C 2004-01-28  [User ID not found]
#sig 3        9456ADE2 2004-02-07  Michael Schiansky <michael#schiansky.de>

                 # type                          id       date       name
   if ($line =~ m#([\w]+)[ !\?][ \dLNPRX]{0,8} +([^ ]+) +([^ ]+)(?: +"?([^<"]*))?#)
# differences:
# " " -> "[ !\?]" (to use 'gpg --check-sigs|sig2dot.mio|springgraph|display')
# "[ \d]" -> "[ \dLRXP]" (signature attributes)
# "[^<]+" -> "[^<]*" (to recognise "pub" lines whitout a name)
#  if ($line =~ m#([\w]+) [ \d]? +([^ ]+) +([^ ]+) +([^<]+)#)
#  if ($line =~ m#([\w]+) +([^ ]+) +([^ ]+) +([^<]+)#)

  {
    my $type = $1;
    my $id = $2;
    my $date = $3;
    my $name = $4 || "";

    $date =~ tr/-//d;
    if ($type eq "pub" or $renderdate eq "" or $date <= $renderdate)
    {
      print STDERR "Using: $line\n" unless $opt{q};
      # strip trailing whitespace more cleanly:
      $name =~ s/\s+$//g;

      #Remove re: http://bugs.debian.org/202484
      #$name =~ s/[^a-zA-Z \.0-9]/_/g; # handle non-7bit names

      if ($type eq "pub")
      {
        $id = (split('/',$id))[1];
        $owner = $id; 
      } 

      # remove comment field
      $name{$id} = (split ' \(', $name)[0] if $name; # gpg 1.4 fixup

      # skip revoked keys 
      if (index($name, $revokestr) >= 0) {
        $revlist{$id} = 1;
        next;
      }

      if ($type eq "uid") {
	$name{$owner} = $id; # gpg 1.4 fixup
      }
  
#      unless (defined @{$sigs{$owner}})
#      {
#        @{$sigs{$owner}} = ();
#      }
      if ($type eq "sig" and lc $name ne $not_found)
      {
	if ($id ne $owner) {
	  push (@{$sigstmp{$owner}},$id);
	  push (@{$signedbytmp{$id}},$owner);
	}
	if ($all or $id ne $owner) {
	  push (@names,$id,$owner);
	}
      }
      if ($type eq "rev" and lc $name ne $not_found)
      {
	if ($id ne $owner) {
	  push (@{$revs{$owner}},$id);
	  #push (@{$revokedby{$id}},$owner);
	}
      }
    } else {
      print STDERR "Skipping due to date: $line\n";
    }
  } else {
    print STDERR "Skipping due to regex: $line\n" if $line ne "";
  }
}

my (%sigs, %signedby);

for my $id (sort {$sigstmp{$a} <=> $sigstmp{$b}} keys %sigstmp) {
  next if (defined $revlist{$id});
  foreach my $owner (@{$signedbytmp{$id}}) {
    next if (defined $revlist{$owner});
    my $revoke = 0;
    foreach my $revid (@{$revs{$owner}}) {
      if ($revid eq $id) {
        $revoke = 1;
      }
    }
    #$res = $revlist{$id};
    if (($revoke == 0)) {
      push (@{$sigs{$owner}},$id);
      push (@{$signedby{$id}},$owner);
    }
  }
}

print "digraph \"debian-keyring\" {\noverlap=scale\nsplines=true\nsep=.1\n";

my %saw;
@saw{@names} = ();
@names = keys %saw;
undef %saw;

my $maxsigcount = 0;
my (%sigcount);

for my $owner (sort {$sigs{$a} <=> $sigs{$b}} keys %sigs)
{
  undef %saw;
  @saw{@{$sigs{$owner}}} = ();
  @{$sigs{$owner}} = keys %saw;
  undef %saw;
  undef %saw;
  $signedby{$owner} ||= [];
  @saw{@{$signedby{$owner}}} = ();
  @{$signedby{$owner}} = keys %saw;
  undef %saw;

  $sigcount{$owner} = scalar(@{$sigs{$owner}});
  if ($sigcount{$owner} > $maxsigcount)
  {
    $maxsigcount = $sigcount{$owner};
  }
}

my %signedbycount;
my ($maxsignedbycount, $maxratio) = (0, 0);

for my $owner (sort {$signedby{$a} <=> $signedby{$b}} keys %signedby)
{
  $signedbycount{$owner} = scalar(@{$signedby{$owner}});
  if ($signedbycount{$owner} > $maxsignedbycount)
  {
    $maxsignedbycount = $signedbycount{$owner};
  }
  if ($sigcount{$owner} and $sigcount{$owner} > 0) {
    if ($signedbycount{$owner} / $sigcount{$owner} > $maxratio)
    {
      $maxratio = $signedbycount{$owner} / $sigcount{$owner};
    }
  }
}
print "//$maxratio\n";

if ($stats) {
    open (STATS,">$stats");
    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";

    for my $owner (sort {$sigcount{$b} <=> $sigcount{$a}} keys %sigs)
    {
	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";
    }
    
    print STATS "</table></body></html>\n";
    close STATS;
}

print "node [style=filled]\n";
for my $id (@names)
{
  if ((not exists $sigcount{$id}) and (not exists $signedbycount{$id}) and not $all) {
    next;
  }
  if ($color)
  {
    my ($red, $green, $blue) = (0, 1/3, 1/3);
    if ($sigcount{$id}) {
      $red = $sigcount{$id} / $maxsigcount;
    }
    if ($sigcount{$id} && $maxratio != 0)
    {
      $green = ($signedbycount{$id} / $sigcount{$id} / $maxratio * .75) * 2/3 + 1/3;
    }
    if ($signedbycount{$id} and $maxsignedbycount != 0) {
      $blue = ($signedbycount{$id} / $maxsignedbycount) * 2/3 + 1/3;
    }

    my ($hue,$saturation,$value) = rgb2hsv($red,$green,$blue);
    printf "//%d %d $red,$green,$blue\n", $sigcount{$id} || 0, $signedbycount{$id} || 0;
    print "\"$id\" [fillcolor=\"$hue,$saturation,$value\",label=\"$name{$id}\"]\n";
  } else {
    print "\"$id\" [label=\"$name{$id}\"]\n";
  }
}
#print "node [style=solid]\n";

for my $owner (sort keys %sigs)
{
 print "{ ";
  for my $id (@{$sigs{$owner}})
  {
    print "\"$id\" ";
  }
  print "} -> \"$owner\"\n";
}

print "}\n";

#  Converts rgb to hsv.  All numbers are within range 0 to 1
#  from http://twiki.org/cgi-bin/view/Codev/WebMap
sub rgb2hsv {
    my ($r, $g ,$b) = @_;
    my $max = maxof($r, maxof($g, $b));
    my $min = minof($r, minof($g, $b));
    my $v = $max;
    my ($s, $h);

    if ($max > 0.0) {
        $s = ($max - $min) / $max;
    } else {
        $s = 0;
    }
    if ($s > 0.0) {
        my ($rc, $gc, $bc, $diff);
            $diff = $max - $min;
        $rc = ($max - $r) / $diff;
        $gc = ($max - $g) / $diff;
        $bc = ($max - $b) / $diff;
        if ($r == $max) {
            $h = ($bc - $gc) / 6.0;
        } elsif ($g == $max) {
            $h = (2.0 + $rc - $bc) / 6.0;
        } else {
            $h = (4.0 + $gc - $rc) / 6.0;
        }
    } else {
       $h = 0.0;
    }
    if ($h < 0.0) {
       $h += 1.0;
    }
    return ($h, $s, $v);
}
sub maxof {
   my ($a, $b) = @_;

   return $a>$b?$a:$b;
}
sub minof {
   my ($a, $b) = @_;

   return $a<$b?$a:$b;
}

# vim:sw=2: