gpgstats-0.0.2/sig2dot.pl

   1 #!/usr/bin/perl
   2
   3 # sig2dot v0.8 (c) Darxus@ChaosReigns.com, released under the GPL
   4 # Download from: http://www.chaosreigns.com/debian-keyring
   5 #
   6 # Parses the (gpg) debian-keyring
   7 # (http://www.debian.org/Packages/unstable/misc/debian-keyring.html) to a format
   8 # suitable for use by dot or neato (package name graphviz,
   9 # http://www.research.att.com/sw/tools/graphviz/) like so:
  10 #
  11 # gpg --list-sigs --keyring /usr/share/keyrings/debian-keyring.gpg | ./sig2dot.pl > debian-keyring.dot
  12 # neato -Tps debian-keyring.dot > debian-keyring.neato.dot.ps
  13 # dot -Tps debian-keyring.dot > debian-keyring.dot.dot.ps
  14
  15 while ($line = <STDIN>)
  16 {
  17   chomp $line;
  18   if ($line =~ m#([^ ]+) +[^ ]+ +[^ ]+ +([^<]+)#)
  19   {
  20     $type = $1;
  21     $name = $2;
  22     chop $name;
  23     #print "type:$type:name:$name:\n";
  24
  25     if ($type eq "pub")
  26     {
  27       $owner = $name;
  28     }
  29
  30     if ($type eq "sig" and $name ne $owner and $name ne '[User id not found')
  31     {
  32       push (@{$sigs{$owner}},$name);
  33       push (@names,$name,$owner);
  34     }
  35   } else {
  36     print STDERR "Couldn't parse: $line\n";
  37   }
  38 }
  39
  40 print "digraph \"debian-keyring\" {\n";
  41
  42 undef %saw;
  43 @saw{@names} = ();
  44 @names = keys %saw;
  45 undef %saw;
  46
  47 for $owner (sort {$sigs{$a} <=> $sigs{$b}} keys %sigs)
  48 {
  49   undef %saw;
  50   @saw{@{$sigs{$owner}}} = ();
  51   @{$sigs{$owner}} = keys %saw;
  52   undef %saw;
  53
  54   #print STDERR scalar(@{$sigs{$owner}})," $owner\n";
  55   $count{$owner} = scalar(@{$sigs{$owner}});
  56 }
  57
  58 open (STATS,">stats.html");
  59 print STATS "<html><body><table border=1>\n";
  60
  61 for $owner (sort {$count{$b} <=> $count{$a}} keys %sigs)
  62 {
  63   print STATS "<tr><td>$owner<td>$count{$owner}<td><img src=\"/images/pipe0.jpg\" height=15 width=",$count{$owner} * 20,">\n";
  64 }
  65
  66 print STATS "</table></body></html>\n";
  67 close STATS;
  68
  69 print "node [style=filled]\n";
  70 for $name (@names)
  71 {
  72   if ($count{$name} > 20)
  73   {
  74     print "\"$name\" [color=red]\n";
  75   } elsif ($count{$name} > 8)
  76   {
  77     print "\"$name\" [color=blue]\n";
  78   }
  79 }
  80 print "node [style=solid]\n";
  81
  82 for $owner (sort keys %sigs)
  83 {
  84   for $name (@{$sigs{$owner}})
  85   {
  86     print "\"$name\" -> \"$owner\" [len=5]\n";
  87   }
  88 }
  89
  90 print "}\n";
  91
  92