#!/usr/bin/perl # $Id: ud-fingerserv,v 1.19 2004/11/18 19:10:57 joey Exp $ # (c) 1999 Randolph Chung. Licensed under the GPL. # (c) 2004 Martin Schulze. Licensed under the GPL. # Copyright (c) 2008 Peter Palfrader use lib '/var/www/userdir-ldap/'; #use lib '/home/randolph/projects/userdir-ldap/web'; use strict vars; use IO::Handle; use IO::Socket; use POSIX qw(:sys_wait_h); use Getopt::Std; use Util; use Net::LDAP; # Global settings... my %config = &Util::ReadConfigFile; my %opts; getopts("fiqhvl:", \%opts); my $use_inetd = $config{use_inetd} || $opts{i}; $| = 1; my %attrs = ( 'cn' => 'First name', 'mn' => 'Middle name', 'sn' => 'Last name', 'email' => 'Email', 'keyfingerprint' => 'Fingerprint', 'key' => 'Key block', 'ircnick' => 'IRC nickname', 'icquin' => 'ICQ UIN', 'jabberjid' => 'Jabber ID', 'labeleduri' => 'URL' ); my @summarykeys = ('cn', 'mn', 'sn', 'email', 'labeleduri', 'ircnick', 'icquin', 'jabberjid', 'keyfingerprint', 'key'); $SIG{__DIE__} = \&DieHandler; $SIG{INT} = \&DieHandler; $SIG{CHLD} = \&Reaper; &help if (defined($opts{h})); my $logfh; unless ($opts{i} || $opts{f}) { die "Need logfile unless running foreground\n" unless (defined($opts{l})); open ($logfh, $opts{l}) or die "Can't open logfile: $!\n"; } else { $logfh = \*STDOUT; } &log("Binding to LDAP server at $config{ldaphost}") if (defined($opts{v})); my $ldap = Net::LDAP->new($config{ldaphost}) || die $1; $ldap->bind; if (!$use_inetd) { unless ($opts{f}) { use POSIX 'setsid'; chdir '/' or die "Can't chdir to /: $!"; open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!"; my $pid; defined($pid = fork) or die "Can't fork: $!"; exit if $pid; setsid or die "Can't start a new session: $!"; defined($pid = fork) or die "Can't fork: $!"; exit if $pid; open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; } &log("Binding to port 79") if (defined($opts{v})); my $server = IO::Socket::INET->new(Proto => 'tcp', LocalPort => 'finger(79)', Listen => SOMAXCONN, Reuse => 1); mydie("Cannot listen on finger port") unless $server; &log("[Server listening for connections]"); my ($pid, $client, $hostinfo); while ($client = $server->accept()) { &log("Forking to handle client request") if (defined($opts{v})); next if $pid = fork; # parent mydie("fork: $!") unless defined $pid; # child $client->autoflush(1); my $hostinfo = gethostbyaddr($client->peeraddr, AF_INET); &log(sprintf("[Connect from %s]", $hostinfo || $client->peerhost)); my $query = &readdata($client); &ProcessQuery($client, $query) if (defined($query)); $client->close; exit; } continue { $client->close; } } else { # inetd &log("inetd mode"); my $sockaddr = getpeername(STDIN); if ($sockaddr) { my ($port, $addr) = unpack_sockaddr_in(getpeername(STDIN)); &log(sprintf("[Connect from %s (%s)]", gethostbyaddr($addr, AF_INET), inet_ntoa($addr))); } else { &log("[Connect via terminal]"); } my $query = &readdata(\*STDIN); &ProcessQuery(\*STDOUT, $query) if (defined($query)); exit; } $ldap->unbind; sub DieHandler { $ldap->unbind if (defined($ldap)); exit 0; } sub Reaper { 1 until (-1 == waitpid(-1, WNOHANG)); $SIG{CHLD} = \&Reaper; } sub ProcessQuery { my $client = shift; my $query = shift; my ($uid, $fields, $mesg, $entries, $dn, $key, $pid, $data); $query =~ s/[^\/,0-9a-z]//gi; # be paranoid about input my ($uid, $fields) = split(/\//, $query, 2); if (($uid eq "") || ($uid =~ /^help$/i)) { &sendhelp($client); return; } &log("Looking up $uid at $config{basedn}, uid=$uid"); $mesg = $ldap->search(base => $config{basedn}, filter => "uid=$uid"); $mesg->code && mydie $mesg->error; $entries = $mesg->as_struct; if ($mesg->count == 0) { print $client "$uid not found at db.debian.org\n"; exit 0; } foreach $dn (sort {$entries->{$a}->{sn}->[0] <=> $entries->{$b}->{sn}->[0]} keys(%$entries)) { $data = $entries->{$dn}; $data->{email}->[0] = sprintf("%s %s %s <%s>", $data->{cn}->[0], $data->{mn}->[0], $data->{sn}->[0], $data->{uid}->[0]."\@$config{emailappend}"); $data->{email}->[0] =~ s/\s+/ /g; my @keyfingerprint = (); for (my $i=0; $i <= $#{$data->{'keyfingerprint'}}; $i++) { push (@keyfingerprint, $data->{keyfingerprint}->[$i]); $data->{keyfingerprint}->[$i] = &Util::FormatFingerPrint($data->{keyfingerprint}->[$i]); $data->{keyfingerprint}->[$i] =~ s, , ,; } print $client "$dn\n"; if (!$fields) { push (@{$data->{key}}, sprintf ("finger %s/key\@db.debian.org", $uid)); foreach $key (@summarykeys) { foreach (@{$data->{$key}}) { print $client "$attrs{$key}: "; print $client "$_\n"; } } } else { # print "$fields\n"; foreach $key (split(/,/, $fields)) { if ($key eq 'key') { foreach (@keyfingerprint) { push (@{$data->{key}}, "\n".&Util::FetchKey($_), 0); } } foreach (@{$data->{$key}}) { print $client "$attrs{$key}: "; print $client "$_\n"; } } } } } sub help { print "fingerserv [-f | -l | -i | -q | -v | -h]\n"; print "-f = foreground; do not detach from tty\n"; print "-i = inetd mode; otherwise runs standalone\n"; print "-q = quiet mode; no output\n"; print "-v = verbose mode\n"; print "-h = this help message\n"; print "-l = log file. Necessary if not using -f or -i\n"; exit 0; } sub log { my $msg = shift; return if (defined($opts{q})); my $time = localtime; print $logfh "$time $msg\n"; } sub mydie { my $msg = shift; log($msg); exit 1; } sub readdata { my $fh = shift; my $in = undef; my $out = undef; my $bytesread = 0; my $ret; my $flags= fcntl($fh, F_GETFL, 0) or mydie "Can't get flags for socket: $!\n"; fcntl($fh, F_SETFL, $flags | O_NONBLOCK) or mydie "Can't make socket nonblocking: $!\n"; while (($bytesread < 1024) && ($out !~ /\n/)) { $ret = sysread($fh, $in, 1024); return undef if (!defined($ret) || ($ret == 0)); $bytesread += $ret; $out .= $in; } $out =~ /(.*?)\n/; return $1; } sub sendhelp { my $client = shift; print $client "userdir-ldap finger daemon\n"; print $client "--------------------------\n"; print $client "finger [/]\@db.debian.org\n"; print $client " where uid is the user id of the user\n"; print $client " the optional attributes parameter specifies what to return\n"; print $client " if nothing is specified, all attributes are returned.\n"; print $client " The following attributes are currently supported:\n"; foreach (@summarykeys) { print $client " $_ : $attrs{$_}\n"; } print $client " Multiple attributes can be separated by commas, like this:\n"; print $client " finger tux/email,key\@db.debian.org\n"; }