ud-fingerserv

   1 #!/usr/bin/perl
   2 # $Id: ud-fingerserv,v 1.3 1999/10/14 04:28:59 tausq Exp $
   3
   4 # (c) 1999 Randolph Chung. Licensed under the GPL. <tausq@debian.org>
   5
   6 use lib 'web';
   7 use strict vars;
   8 #use Apache::Registry;
   9 use IO::Socket;
  10 use POSIX qw(:sys_wait_h);
  11 use Util;
  12 use Net::LDAP qw(:all);
  13
  14 # Global settings...
  15 my %config = &Util::ReadConfigFile;
  16
  17 my %attrs = (
  18   'cn' => 'First name',
  19   'mn' => 'Middle name',
  20   'sn' => 'Last name',
  21   'keyfingerprint' => 'Fingerprint',
  22   'key' => 'Key block',
  23   'ircnick' => 'IRC nickname'
  24 );
  25
  26 my @summarykeys = ('cn', 'mn', 'sn', 'ircnick', 'keyfingerprint', 'key');
  27
  28 my ($ldap, $mesg, $dn, $entries, $data, %output, $key, $hostlist, $hostdetails, $selected, %summary);
  29 sub DieHandler {
  30   $ldap->unbind if (defined($ldap));
  31 }
  32
  33 sub Reaper {
  34   1 until (-1 == waitpid(-1, WNOHANG));
  35   $SIG{CHLD} = \&Reaper;
  36 }
  37
  38 $SIG{__DIE__} = \&DieHandler;
  39 $SIG{CHLD} = \&Reaper;
  40
  41 $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
  42 $mesg;
  43 $ldap->bind;
  44
  45 my $server = IO::Socket::INET->new(Proto => 'tcp',
  46                                    LocalPort => 'finger(79)',
  47                                    Listen => SOMAXCONN,
  48                                    Reuse => 1);
  49
  50 die "Cannot listen on finger port" unless $server;
  51 print "[Server listening for connections]\n";
  52
  53 my ($mesg, %entries, $dn, $key, $pid);
  54
  55 my $client;
  56 while ($client = $server->accept()) {
  57   next if $pid = fork; # parent
  58   die "fork: $!" unless defined $pid;
  59
  60   # child
  61   $client->autoflush(1);
  62   my $hostinfo = gethostbyaddr($client->peeraddr, AF_INET);
  63   printf "[Connect from %s]\n", $hostinfo || $client->peerhost;
  64   my $query = <$client>;
  65   $query =~ s/[^\/,0-9a-z]//gi; # be paranoid about input
  66   my ($uid, $fields) = split(/\//, $query, 2);
  67
  68 #  print "Looking up $uid at $config{basedn}, uid=$uid\n";
  69
  70   $mesg = $ldap->search(base  => $config{basedn}, filter => "uid=$uid");
  71   $mesg->code && die $mesg->error;
  72   $entries = $mesg->as_struct;
  73
  74   foreach $dn (sort {$entries->{$a}->{sn}->[0] <=> $entries->{$b}->{sn}->[0]} keys(%$entries)) {
  75     $data = $entries->{$dn};
  76
  77     $data->{key} = [];
  78     foreach (@{$data->{keyfingerprint}}) {
  79       push (@{$data->{key}}, "\n".&Util::FetchKey($_));
  80     }
  81
  82     print $client "$dn\n";
  83     if (!$fields) {
  84       foreach $key (@summarykeys) {
  85         foreach (@{$data->{$key}}) {
  86           print $client "$attrs{$key}: ";
  87           print $client "$_\n";
  88         }
  89       }
  90     } else {
  91 #      print "$fields\n";
  92       foreach $key (split(/,/, $fields)) {
  93         foreach (@{$data->{$key}}) {
  94           print $client "$attrs{$key}: ";
  95           print $client "$_\n";
  96         }
  97       }
  98     }
  99   }
 100   $client->close;
 101   exit;
 102 } continue {
 103   $client->close;
 104 }
 105
 106 $ldap->unbind;