ud-fingerserv

   1 #!/usr/bin/perl
   2 # $Id: ud-fingerserv,v 1.16 2004/10/24 18:34:12 joey Exp $
   3
   4 # (c) 1999 Randolph Chung. Licensed under the GPL. <tausq@debian.org>
   5
   6 use lib '/var/www/userdir-ldap/';
   7 #use lib '/home/randolph/projects/userdir-ldap/web';
   8 use strict vars;
   9 use IO::Handle;
  10 use IO::Socket;
  11 use POSIX qw(:sys_wait_h);
  12 use Getopt::Std;
  13 use Util;
  14 use Net::LDAP qw(:all);
  15
  16 # Global settings...
  17 my %config = &Util::ReadConfigFile;
  18 my %opts;
  19 getopts("iqhv", \%opts);
  20 my $use_inetd = $config{use_inetd} || $opts{i};
  21 $| = 1;
  22
  23 my %attrs = (
  24   'cn' => 'First name',
  25   'mn' => 'Middle name',
  26   'sn' => 'Last name',
  27   'email' => 'Email',
  28   'keyfingerprint' => 'Fingerprint',
  29   'key' => 'Key block',
  30   'ircnick' => 'IRC nickname',
  31   'icquin' => 'ICQ UIN',
  32   'labeleduri' => 'URL'
  33 );
  34
  35 my @summarykeys = ('cn', 'mn', 'sn', 'email', 'labeleduri', 'ircnick', 'icquin', 'keyfingerprint', 'key');
  36
  37 $SIG{__DIE__} = \&DieHandler;
  38 $SIG{INT} = \&DieHandler;
  39 $SIG{CHLD} = \&Reaper;
  40
  41 &help if (defined($opts{h}));
  42 #my $logfh = STDOUT; #TODO
  43
  44 &log("Binding to LDAP server at $config{ldaphost}") if (defined($opts{v}));
  45 my $ldap = Net::LDAP->new($config{ldaphost}) || die $1;
  46 $ldap->bind;
  47
  48 if (!$use_inetd) {
  49   &log("Binding to port 79") if (defined($opts{v}));
  50   my $server = IO::Socket::INET->new(Proto => 'tcp',
  51                                      LocalPort => 'finger(79)',
  52                                      Listen => SOMAXCONN,
  53                                      Reuse => 1);
  54
  55   die "Cannot listen on finger port" unless $server;
  56   &log("[Server listening for connections]");
  57
  58   my ($pid, $client, $hostinfo);
  59
  60   while ($client = $server->accept()) {
  61     &log("Forking to handle client request") if (defined($opts{v}));
  62     next if $pid = fork; # parent
  63     die "fork: $!" unless defined $pid;
  64
  65     # child
  66     $client->autoflush(1);
  67     my $hostinfo = gethostbyaddr($client->peeraddr, AF_INET);
  68     &log(sprintf("[Connect from %s]", $hostinfo || $client->peerhost));
  69     my $query = &readdata($client);
  70     &ProcessQuery($client, $query) if (defined($query));
  71     $client->close;
  72     exit;
  73   } continue {
  74     $client->close;
  75   }
  76 } else { # inetd
  77   &log("inetd mode");
  78   my $sockaddr = getpeername(STDIN);
  79   my ($port, $addr) = unpack_sockaddr_in(getpeername(STDIN));
  80   &log(sprintf("[Connect from %s (%s)]", gethostbyaddr($addr, AF_INET), inet_ntoa($addr)));
  81   my $query = &readdata(\*STDIN);
  82   &ProcessQuery(\*STDOUT, $query) if (defined($query));
  83   exit;
  84 }
  85
  86 $ldap->unbind;
  87
  88 sub DieHandler {
  89   $ldap->unbind if (defined($ldap));
  90   exit 0;
  91 }
  92
  93 sub Reaper {
  94   1 until (-1 == waitpid(-1, WNOHANG));
  95   $SIG{CHLD} = \&Reaper;
  96 }
  97
  98 sub ProcessQuery {
  99   my $client = shift;
 100   my $query = shift;
 101
 102   my ($uid, $fields, $mesg, $entries, $dn, $key, $pid, $data);
 103
 104   $query =~ s/[^\/,0-9a-z]//gi; # be paranoid about input
 105   my ($uid, $fields) = split(/\//, $query, 2);
 106
 107   if (($uid eq "") || ($uid =~ /^help$/i)) {
 108     &sendhelp($client);
 109     return;
 110   }
 111
 112   &log("Looking up $uid at $config{basedn}, uid=$uid");
 113
 114   $mesg = $ldap->search(base  => $config{basedn}, filter => "uid=$uid");
 115   $mesg->code && die $mesg->error;
 116   $entries = $mesg->as_struct;
 117
 118   if ($mesg->count == 0) {
 119     print $client "$uid not found at db.debian.org\n";
 120     exit 0;
 121   }
 122
 123   foreach $dn (sort {$entries->{$a}->{sn}->[0] <=> $entries->{$b}->{sn}->[0]} keys(%$entries)) {
 124     $data = $entries->{$dn};
 125
 126     $data->{key} = [];
 127     foreach (@{$data->{keyfingerprint}}) {
 128       push (@{$data->{key}}, "\n".&Util::FetchKey($_));
 129     }
 130
 131     $data->{email}->[0] = sprintf("%s %s %s <%s>", $data->{cn}->[0],
 132                                   $data->{mn}->[0], $data->{sn}->[0],
 133                                   $data->{uid}->[0]."\@$config{emailappend}");
 134
 135     $data->{email}->[0] =~ s/\s+/ /g;
 136
 137     for (my $i=0; $i <= $#{$data->{'keyfingerprint'}}; $i++) {
 138       $data->{keyfingerprint}->[$i] = &Util::FormatFingerPrint($data->{keyfingerprint}->[$i]);
 139       $data->{keyfingerprint}->[$i] =~ s,&nbsp;, ,;
 140     }
 141     print $client "$dn\n";
 142     if (!$fields) {
 143       foreach $key (@summarykeys) {
 144         foreach (@{$data->{$key}}) {
 145           print $client "$attrs{$key}: ";
 146           print $client "$_\n";
 147         }
 148       }
 149     } else {
 150   #     print "$fields\n";
 151       foreach $key (split(/,/, $fields)) {
 152         foreach (@{$data->{$key}}) {
 153           print $client "$attrs{$key}: ";
 154           print $client "$_\n";
 155         }
 156       }
 157     }
 158   }
 159 }
 160
 161 sub help {
 162   print "fingerserv [-i | -q | -v | -h]\n";
 163   print "-i = inetd mode; otherwise runs standalone\n";
 164   print "-q = quiet mode; no output\n";
 165   print "-v = verbose mode\n";
 166   print "-h = this help message\n";
 167   exit 0;
 168 }
 169
 170 sub log {
 171   my $msg = shift;
 172   return if (defined($opts{q}));
 173
 174   my $time = localtime;
 175   print STDERR "$time $msg\n";
 176 }
 177
 178 sub readdata {
 179   my $fh = shift;
 180   my $in = undef;
 181   my $out = undef;
 182   my $bytesread = 0;
 183   my $ret;
 184
 185   my $flags= fcntl($fh, F_GETFL, 0)
 186      or die "Can't get flags for socket: $!\n";
 187   fcntl($fh, F_SETFL, $flags | O_NONBLOCK)
 188      or die "Can't make socket nonblocking: $!\n";
 189
 190   while (($bytesread < 1024) && ($out !~ /\n/)) {
 191     $ret = sysread($fh, $in, 1024);
 192     return undef if (!defined($ret) || ($ret == 0));
 193     $bytesread += $ret;
 194     $out .= $in;
 195   }
 196
 197   $out =~ /(.*?)\n/;
 198   return $1;
 199 }
 200
 201 sub sendhelp {
 202   my $client = shift;
 203
 204   print $client "userdir-ldap finger daemon\n";
 205   print $client "--------------------------\n";
 206   print $client "finger <uid>[/<attributes>]\@db.debian.org\n";
 207   print $client "  where uid is the user id of the user\n";
 208   print $client "  the optional attributes parameter specifies what to return\n";
 209   print $client "    if nothing is specified, all attributes are returned.\n";
 210   print $client "    The following attributes are currently supported:\n";
 211   foreach (@summarykeys) {
 212     print $client "      $_ : $attrs{$_}\n";
 213   }
 214   print $client "    Multiple attributes can be separated by commas, like this:\n";
 215   print $client "    finger tux/email,key\@db.debian.org\n";
 216 }