login.cgi

   1 #!/usr/bin/perl
   2
   3 # $Id: login.cgi,v 1.4 1999/12/11 07:03:45 tausq Exp $
   4 # (c) 1999 Randolph Chung. Licensed under the GPL. <tausq@debian.org>
   5
   6 use lib '.';
   7 use strict;
   8 #use Apache::Registry;
   9 use CGI;
  10 use Util;
  11 use URI::Escape;
  12 use Crypt::Blowfish;
  13 use Net::LDAP qw(:all);
  14
  15 my %config = &Util::ReadConfigFile;
  16
  17 my $query = new CGI;
  18 my $proto = ($ENV{HTTPS} ? "https" : "http");
  19
  20 if (!($query->param('username')) || !($query->param('password'))) {
  21   print "Location: $proto://$ENV{SERVER_NAME}/$config{webloginurl}\n\n";
  22   exit;
  23 }
  24
  25 my $key = &Util::CreateKey($config{blowfishkeylen}); # human-readable version of the key
  26 my $hrkey = unpack("H".($config{blowfishkeylen}*2), $key);
  27 my $cipher = new Crypt::Blowfish $key;
  28
  29 my $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
  30
  31 my $username = $query->param('username');
  32 my $password = $query->param('password');
  33 my $binddn = "uid=$username,$config{basedn}";
  34
  35 &logf(sprintf("proto=[%s]; key=[%s]; hrkey=[%s]; username=[%s]; passwd=[%s]; binddn=[%s]",
  36               $proto, $key, $hrkey, $username, ($password ? "shh!" : "(null)"), $binddn));
  37
  38 my $mesg = $ldap->bind($binddn, password => $password);
  39 $mesg->sync;
  40
  41 if ($mesg->code == LDAP_SUCCESS) {
  42   my $cryptid = &Util::SavePasswordToFile($username, $password, $cipher);
  43
  44   if ($query->param('update')) {
  45     my $url = "$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$username&authtoken=$cryptid,$hrkey&editdn=";
  46     $url .= uri_escape("uid=$username,$config{basedn}", "\x00-\x40\x7f-\xff");
  47     &logf("redirect url = [$url]");
  48     print "Location: $url\n\n";
  49   } else {
  50     my $url = "$proto://$ENV{SERVER_NAME}/$config{websearchurl}?id=$username&authtoken=$cryptid,$hrkey";
  51     &logf("redirect url = [$url]");
  52     print "Location: $url\n\n";
  53   }
  54
  55   $ldap->unbind;
  56 } else {
  57   &logf("bad auth");
  58   print "Content-type: text/html\n\n";
  59   print "<html><body><h1>Not authenticated</h1></body></html>\n";
  60 }
  61
  62 sub logf {
  63   my $msg = shift;
  64   my $t = localtime;
  65
  66   if (open(L, ">>$config{weblogfile}")) {
  67     print L sprintf("[%s] %s: %s\n", $ENV{REMOTE_ADDR}, $t, $msg);
  68     close L;
  69   }
  70 }
  71
  72 exit 0;