From a580939d3d1f6dfb9b4a7aa2b75ed814e3f13cca Mon Sep 17 00:00:00 2001 From: joey <> Date: Thu, 18 Nov 2004 13:37:21 +0000 Subject: [PATCH] Moved into its own package userdir-ldap-cgi --- web/Util.pm | 336 ----------------------------------------------- web/fetchkey.cgi | 30 ----- web/login.cgi | 74 ----------- web/logout.cgi | 24 ---- web/machines.cgi | 172 ------------------------ web/search.cgi | 271 -------------------------------------- web/update.cgi | 146 -------------------- 7 files changed, 1053 deletions(-) delete mode 100644 web/Util.pm delete mode 100755 web/fetchkey.cgi delete mode 100755 web/login.cgi delete mode 100755 web/logout.cgi delete mode 100755 web/machines.cgi delete mode 100755 web/search.cgi delete mode 100755 web/update.cgi diff --git a/web/Util.pm b/web/Util.pm deleted file mode 100644 index 8efabfb..0000000 --- a/web/Util.pm +++ /dev/null @@ -1,336 +0,0 @@ -# -*- perl -*-x -package Util; - -use strict; -use Date::Manip qw(ParseDate); - -my $blocksize = 8; # A blowfish block is 8 bytes -my $configfile = "/etc/userdir-ldap/userdir-ldap.conf"; -#my $configfile = "/home/randolph/html/debian/perl/userdir-ldap.conf"; - -my %config = &ReadConfigFile; - -my $hascryptix = 1; -eval 'use Crypt::Blowfish'; -if ($@) { - $hascryptix = undef; -} - -sub CreateKey { - my $keysize = shift; - my $input; - open (F, "encrypt(substr($input, $pos, $blocksize))) if ($hascryptix); - } - return $output; -} - -sub Decrypt { - # like encrypt, needs to deal with big blocks. Note that we assume - # trailing spaces are unimportant. - my $cipher = shift; - my $input = shift; - my ($pos, $portion, $output, $len); - - ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true... - - for ($pos = 0; $pos < length($input); $pos += $blocksize*2) { - $portion = pack("H16", substr($input, $pos, $blocksize*2)); - $output .= $cipher->decrypt($portion) if ($hascryptix); - } - - # check length byte, discard junk - $len = substr($output, 0, 1); - $output = substr($output, 1, ord($len)); - return $output; -} - -sub SavePasswordToFile { - my $userid = shift; - my $password = shift; - my $cipher = shift; - - my $cryptuser = crypt($userid, &CreateCryptSalt); - my $secret = Encrypt($cipher, $password); - $cryptuser =~ y/\//_/; # translate slashes to underscores... - - my $fn = "$config{authtokenpath}/$cryptuser"; - open (F, ">$fn") || &HTMLError("$fn: $!"); - print F "$secret\n"; - print F time."\n"; - close F; - chmod 0600, $fn; - return $cryptuser; -} - -sub ReadPasswordFromFile { - my $userid = shift; - my $cipher = shift; - my $passwd; - my $time; - - $userid =~ y/\//_/; # translate slashes to underscores... - - # if we couldn't read the password file, assume user is unauthenticated. is this ok? - open (F, "<$config{authtokenpath}/$userid") || return undef; - chomp($passwd = ); - chomp($time = ); - close F; - - # check to make sure we read something - return undef if (!$passwd || !$time); - - # check to make sure the time is positive, and that the auth token - # has not expired - my $tdiff = (time - $time); - &HTMLError("Your authentication token has expired. Please relogin") if (($tdiff < 0) || ($tdiff > $config{authexpires})); - - return Decrypt($cipher, $passwd); -} - -sub CheckAuthToken { - my ($id, $hrkey) = split(/,/, shift, 2); - return undef if (!$id || !$hrkey); - my $key = pack("H".(length($hrkey)), $hrkey); - my $cipher = new Crypt::Blowfish $key; - my $r = ReadPasswordFromFile($id, $cipher); - if ($r) { - UpdateAuthToken("$id,$hrkey", $r); - } else { - ClearAuthToken("$id,$hrkey") - } - return $r; -} - -sub ClearAuthToken { - my ($id, $hrkey) = split(/,/, shift, 2); - $id =~ y/\//_/; # switch / to _ - unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!"); -} - -sub UpdateAuthToken { - my ($id, $hrkey) = split(/,/, shift, 2); - my $password = shift; - my $key = pack("H".(length($hrkey)), $hrkey); - $id =~ y/\//_/; # switch / to _ - my $cipher = new Crypt::Blowfish $key; - my $secret = Encrypt($cipher, $password); - - my $fn = "$config{authtokenpath}/$id"; - open (F, ">$fn") || &HTMLError("$fn: $!"); - print F "$secret\n"; - print F time."\n"; - close F; - chmod 0600, "$fn" || &HTMLError("$fn: $!"); - return 1; -} - -sub FormatFingerPrint { - my $in = shift; - my $out; - - if (length($in) == 32) { - foreach (0..15) { - $out .= substr($in, $_*2, 2)." "; - $out .= " " if ($_ == 7); - } - } else { - foreach (0..int(length($in)/2)) { - $out .= substr($in, $_*4, 4)." "; - } - } - return $out; -} - -sub FetchKey { - my $fingerprint = shift; - my ($out, $keyringparam) = undef; - - foreach (split(/:/, $config{keyrings})) { - $keyringparam .= "--keyring $_ "; - } - - $fingerprint =~ s/\s//g; - $fingerprint = "0x".$fingerprint; - - $/ = undef; # just suck it up .... - open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --check-sigs --fingerprint $fingerprint|"); - $out = ; - close FP; - open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --export -a $fingerprint|"); - $out .= ; - close FP; - $/ = "\n"; - - return $out; -} - -sub FormatTimestamp { - my $in = shift; - $in =~ /^(....)(..)(..)(..)(..)(..)/; - - return sprintf("%04d/%02d/%02d %02d:%02d:%02d UTC", $1,$2,$3,$4,$5,$6); -} - -sub FormatLastSeen { -# Format: -# [Tue, 11 Jan 2000 02:37:18] "Joey Hess " " archive/latest/7130" "<20000110181924.H19910@kitenet.net>" -# [Mon, 10 Jan 2000 21:48:19] "9E1E 1052 F8BB A351 0606 5527 50BB 2974 2D59 A7D2" " archive/latest/58632" "<20000110200506.13257.qmail@master.debian.org>" - my $lastseenpgp = shift; - my $lastseenfrom = shift; - my ($d1, $d2, $lastseen); - - return "No activity detected" if (!$lastseenpgp && !$lastseenfrom); - $lastseen = $lastseenfrom if (!$lastseenpgp); - - if ($lastseenfrom && $lastseenpgp) { - ($d1) = ($lastseenpgp =~ /^\[(.+?)\]/); $d1 = ParseDate($d1); - ($d2) = ($lastseenfrom =~ /^\[(.+?)\]/); $d2 = ParseDate($d2); - $lastseen = (($d1 gt $d2) ? $lastseenpgp : $lastseenfrom); - } - - my ($date,$user,$list,$msgid) = ($lastseen =~ /^\[(.+?)\]\s+"(.+?)"\s+"(?:<(.+?)>.*?|\-)"\s+"<(.+?)>"/); - $list = "on $list" if ($list); - return "$date $list
 Message ID: $msgid"; -} - -sub LookupCountry { - my $in = shift; - my ($abbrev, $country); - open (F, $config{countrylist}) || return uc($in); - while () { - chomp; - ($abbrev, $country) = split(/\s+/, $_, 2); - if ($abbrev eq $in) { - close F; - return $country; - } - } - close F; - return uc($in); -} - -#################### -# Some HTML Routines - -my $htmlhdrsent = 0; - -sub HTMLSendHeader { - print "Content-type: text/html\n\n" if (!$htmlhdrsent); - $htmlhdrsent = 1; -} - -sub HTMLPrint { - &HTMLSendHeader if (!$htmlhdrsent); - print shift; -} - -sub HTMLError { - HTMLPrint(shift); - die "\n"; -} - -sub CheckLatLong { - my ($lat, $long) = @_; - - $lat =~ s/[^-+\.\d]//g; $long =~ s/[^-+\.\d]//g; - - if (($lat =~ /^(\-|\+?)\d+(\.\d+)?/) && ($long =~ /^(\-|\+?)\d+(\.\d+)?/)) { - return ($lat, $long); - } else { - return ("", ""); - } -} - -sub FixParams { - my $query = shift; - my $key; - my @names = $query->param; - - foreach $key (@names) { # web security is a joke ... - $_ = $query->param($key); - s/&/&/g; - s/[<\x8B]/</g; - s/[>\x9B]/>/g; - - $query->param($key, $_); - } -} - - -sub LDAPUpdate { - my $ldap = shift; - my $dn = shift; - my $attr = shift; - my $val = shift; - my $mesg; - - if (!$val) { - $mesg = $ldap->modify($dn, delete => { $attr => [] }); - } else { - $val = [ $val ] if (!ref($val)); - $mesg = $ldap->modify($dn, replace => { $attr => $val }); - $mesg->code && &Util::HTMLError("error updating $attr: ".$mesg->error); - } -} - -################### -# Config file stuff -sub ReadConfigFile { - # reads a config file and results a hashref with the results - my (%config, $attr, $setting); - open (F, "<$configfile") || &HTMLError("Cannot open $configfile: $!"); - while () { - chomp; - if ((!/^\s*#/) && ($_ ne "")) { - # Chop off any trailing comments - s/#.*//; - ($attr, $setting) = split(/=/, $_, 2); - $setting =~ s/"//g; #" - $setting =~ s/;$//; - $attr =~ s/^\s+//; $attr =~ s/\s+$//; - $setting =~ s/^\s+//; $setting =~ s/\s+$//; - $config{$attr} = $setting; - } - } - close F; - return %config; -} - -1; diff --git a/web/fetchkey.cgi b/web/fetchkey.cgi deleted file mode 100755 index a9d8539..0000000 --- a/web/fetchkey.cgi +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -# $Id: fetchkey.cgi,v 1.2 1999/09/26 01:20:39 tausq Exp $ -# (c) 1999 Randolph Chung. Licensed under the GPL. - -use strict; -use CGI; -use Util; - -# Global settings... -my %config = &Util::ReadConfigFile; - -my $query = new CGI; -print "Content-type: text/plain\n\n"; - -my $fp = $query->param('fingerprint'); - -if ($fp) { - my $key = &Util::FetchKey($fp); - if ($key) { - print $key; - } else { - print "Sorry, no key found matching fingerprint $fp\n"; - } -} else { - print "No fingerprint given\n"; -} - -exit 0; - diff --git a/web/login.cgi b/web/login.cgi deleted file mode 100755 index 0058aa9..0000000 --- a/web/login.cgi +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl - -# $Id: login.cgi,v 1.8 2003/03/13 04:25:56 rmurray Exp $ -# (c) 1999 Randolph Chung. Licensed under the GPL. - -use lib '.'; -use strict; -#use Apache::Registry; -use CGI; -use Util; -use URI::Escape; -use Crypt::Blowfish; -use Net::LDAP qw(:all); - -my %config = &Util::ReadConfigFile; - -my $query = new CGI; -my $proto = ($ENV{HTTPS} ? "https" : "http"); - -if ($proto eq "http" || !($query->param('username')) || !($query->param('password'))) { - print "Location: https://$ENV{SERVER_NAME}/$config{webloginurl}\n\n"; - exit; -} - -my $key = &Util::CreateKey($config{blowfishkeylen}); # human-readable version of the key -my $hrkey = unpack("H".($config{blowfishkeylen}*2), $key); -my $cipher = new Crypt::Blowfish $key; - -my $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!); - -my $username = $query->param('username'); -my $password = $query->param('password'); -my $binddn = "uid=$username,$config{basedn}"; - -my $mesg = $ldap->bind($binddn, password => $password); -$mesg->sync; - -if ($mesg->code == LDAP_SUCCESS) { - # HACK HACK HACK - # Check for md5 password, and update as necessary - $mesg = $ldap->search(base => $config{basedn}, - filter => "(uid=$username)"); - $mesg->code && &Util::HTMLError($mesg->error); - my $entries = $mesg->as_struct; - my $dn = (keys %$entries)[0]; - my $oldpassword = $entries->{$dn}->{userpassword}->[0]; - if ($oldpassword !~ /^{crypt}\$1\$/) { - # Update their password to md5 - open (LOG, ">>$config{weblogfile}"); - print LOG scalar(localtime); - print LOG ": Updating MD5 password for $dn\n"; - close LOG; - my $newpassword = '{crypt}'.crypt($password, &Util::CreateCryptSalt(1)); - &Util::LDAPUpdate($ldap, $dn, 'userPassword', $newpassword); - } - ## END HACK HACK HACK - - my $cryptid = &Util::SavePasswordToFile($username, $password, $cipher); - - if ($query->param('update')) { - my $url = "$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$username&authtoken=$cryptid,$hrkey&editdn="; - $url .= uri_escape("uid=$username,$config{basedn}", "\x00-\x40\x7f-\xff"); - print "Location: $url\n\n"; - } else { - my $url = "$proto://$ENV{SERVER_NAME}/$config{websearchurl}?id=$username&authtoken=$cryptid,$hrkey"; - print "Location: $url\n\n"; - } - - $ldap->unbind; -} else { - print "Content-type: text/html\n\n"; - print "

Not authenticated

\n"; -} - diff --git a/web/logout.cgi b/web/logout.cgi deleted file mode 100755 index 9bd6e0f..0000000 --- a/web/logout.cgi +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl - -# $Id: logout.cgi,v 1.2 1999/09/26 01:20:39 tausq Exp $ -# (c) 1999 Randolph Chung. Licensed under the GPL. - -use lib '.'; -use strict vars; -#use Apache::Registry; -use CGI; -use Util; -use Net::LDAP qw(:all); - -my %config = &Util::ReadConfigFile; -my $proto = ($ENV{HTTPS} ? "https" : "http"); - -my $query = new CGI; -my $id = $query->param('id'); -my $authtoken = $query->param('authtoken'); -&Util::ClearAuthToken($authtoken); -my $doneurl = $query->param('done') || "$config{websearchurl}"; - -&Util::ClearAuthToken($authtoken); - -print "Location: $proto://$ENV{SERVER_NAME}/$doneurl\n\n"; diff --git a/web/machines.cgi b/web/machines.cgi deleted file mode 100755 index 938e330..0000000 --- a/web/machines.cgi +++ /dev/null @@ -1,172 +0,0 @@ -#!/usr/bin/perl -# $Id: machines.cgi,v 1.10 2001/12/03 05:02:13 rmurray Exp $ - -# (c) 1999 Randolph Chung. Licensed under the GPL. - -use lib '.'; -use strict vars; -#use Apache::Registry; -use CGI; -use Util; -use Net::LDAP qw(:all); - -my (%attrs, @attrorder, %summaryattrs, @summaryorder); - -# This defines the description of the fields, and which fields are retrieved -%attrs = ('hostname' => 'Host name', - 'admin' => 'Admin contact', - 'architecture' => 'Architecture', - 'distribution' => 'Distribution', - 'access' => 'Access', - 'sponsor' => 'Sponsor', - 'sponsor-admin' => 'Sponsor admin', - 'location' => 'Location', - 'machine' => 'Processor', - 'memory' => 'Memory', - 'disk' => 'Disk space', - 'bandwidth' => 'Bandwidth', - 'status' => 'Status', - 'notes' => 'Notes', - 'sshrsahostkey' => 'SSH host key', - 'description' => 'Description', - 'createtimestamp' => 'Entry created', - 'modifytimestamp' => 'Entry modified' - ); - -# This defines what fields are displayed, and in what order -@attrorder = qw(hostname admin architecture distribution access - sponsor sponsor-admin location machine memory - disk bandwidth status notes sshrsahostkey - description createtimestamp modifytimestamp); - -# ditto for summary -%summaryattrs = ('hostname' => 'Host name', - 'host' => 'just for a link', - 'architecture' => 'Architecture', - 'distribution' => 'Distribution', - 'status' => 'Status', - 'access' => 'Access'); - -@summaryorder = ('hostname', 'architecture', 'distribution', 'status', 'access'); - -# Global settings... -my %config = &Util::ReadConfigFile; - -my ($ldap, $mesg, $dn, $entries, $data, %output, $key, $hostlist, $hostdetails, $selected, %summary); -sub DieHandler { - $ldap->unbind if (defined($ldap)); -} - -$SIG{__DIE__} = \&DieHandler; - -my $query = new CGI; -my $host = lc($query->param('host')); - -&Util::HTMLSendHeader; -$ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!); -$mesg; -$ldap->bind; - -$mesg = $ldap->search(base => $config{hostbasedn}, filter => 'host=*'); -$mesg->code && &Util::HTMLError($mesg->error); -$entries = $mesg->as_struct; - -foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]} keys(%$entries)) { - $data = $entries->{$dn}; - - my $thishost = $data->{host}->[0]; - $selected = ""; - - if (lc($thishost) eq $host) { - $output{havehostdata} = 1; - - foreach $key (keys(%attrs)) { - $output{$key} = $data->{$key}->[0]; - } - - $output{hostname} = undef; - foreach my $hostname (@{$data->{hostname}}) { - $output{hostname} .= sprintf("%s%s", ($output{hostname} ? ', ' : ''), $hostname); - } - - # Modified/created time. TODO: maybe add is the name of the creator/modifier - $output{modifytimestamp} = &Util::FormatTimestamp($output{modifytimestamp}); - $output{createtimestamp} = &Util::FormatTimestamp($output{createtimestamp}); - - # Format email addresses - $output{admin} = sprintf("%s", $output{admin}, $output{admin}); - $output{'sponsor-admin'} = sprintf("%s", $output{'sponsor-admin'}, $output{'sponsor-admin'}); - - $output{sshrsahostkey} = undef; - foreach $key (@{$data->{sshrsahostkey}}) { - $output{sshrsahostkey} .= $key . "
"; - } - - # URL - my ($sponsor, $url) = undef; - $output{sponsor} = undef; - foreach $sponsor (@{$data->{sponsor}}) { - $sponsor =~ m#((http|ftp)://\S+)#i; - $url = $1; - $sponsor =~ s/$url//; - $output{sponsor} .= "
" if ($output{sponsor}); - if ($url) { - $output{sponsor} .= sprintf("%s", $url, $sponsor); - } else { - $output{sponsor} .= $sponsor; - } - } - - $selected = " selected "; - } - - $hostlist .= "