X-Git-Url: https://git.adam-barratt.org.uk/?a=blobdiff_plain;f=Util.pm;h=1688dc4d8078c85ff11a87f1267885225765a10d;hb=6dc665d6625bfa6a358002ca840e3e10bed49e41;hp=89ef3fb8c6a982a94ff150bd910a61cd12015e1d;hpb=a6e49f39cdff3079e4d70b88b1ae4736f37a2176;p=mirror%2Fuserdir-ldap-cgi.git diff --git a/Util.pm b/Util.pm index 89ef3fb..1688dc4 100644 --- a/Util.pm +++ b/Util.pm @@ -2,14 +2,20 @@ package Util; use strict; -use Crypt::Blowfish; +use Date::Manip qw(ParseDate); my $blocksize = 8; # A blowfish block is 8 bytes my $configfile = "/etc/userdir-ldap/userdir-ldap.conf"; -#my $configfile = "./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; @@ -45,10 +51,12 @@ sub Encrypt { my $input = shift; my ($pos, $output); - $input .= " " x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize)); + # prepend a length byte */ + $input = chr(length($input)).$input; + $input .= "\001" x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize)); - for ($pos = 0; $pos < length($input); $pos += $blocksize) { - $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize))); + for ($pos = 0; $pos < length($input); $pos += $blocksize) { + $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize))) if ($hascryptix); } return $output; } @@ -58,16 +66,18 @@ sub Decrypt { # trailing spaces are unimportant. my $cipher = shift; my $input = shift; - my ($pos, $portion, $output); + 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); + $output .= $cipher->decrypt($portion) if ($hascryptix); } - - $output =~ s/ +$//; + + # check length byte, discard junk + $len = substr($output, 0, 1); + $output = substr($output, 1, ord($len)); return $output; } @@ -109,33 +119,33 @@ sub ReadPasswordFromFile { # 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})); + &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); + 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); + UpdateAuthToken("$id,$hrkey", $r); } else { - ClearAuthToken("$id:$hrkey") + ClearAuthToken("$id,$hrkey") } return $r; } sub ClearAuthToken { - my ($id, $hrkey) = split(/:/, shift, 2); + 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 ($id, $hrkey) = split(/,/, shift, 2); my $password = shift; my $key = pack("H".(length($hrkey)), $hrkey); $id =~ y/\//_/; # switch / to _ @@ -161,15 +171,17 @@ sub FormatFingerPrint { $out .= " " if ($_ == 7); } } else { - foreach (0..int(length($in)/2)) { + foreach (0..int(length($in)/4)) { $out .= substr($in, $_*4, 4)." "; } } + chop $out; return $out; } sub FetchKey { my $fingerprint = shift; + my $signatures = shift; my ($out, $keyringparam) = undef; foreach (split(/:/, $config{keyrings})) { @@ -179,10 +191,13 @@ sub FetchKey { $fingerprint =~ s/\s//g; $fingerprint = "0x".$fingerprint; + local $ENV{PATH} = ''; $/ = undef; # just suck it up .... - open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --list-sigs --fingerprint $fingerprint|"); - $out = ; - close FP; + if ($signatures) { + open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --list-sigs --fingerprint $fingerprint|"); + $out = ; + close FP; + } open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --export -a $fingerprint|"); $out .= ; close FP; @@ -198,6 +213,28 @@ sub FormatTimestamp { 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); @@ -220,7 +257,7 @@ sub LookupCountry { my $htmlhdrsent = 0; sub HTMLSendHeader { - print "Content-type: text/html\n\n" if (!$htmlhdrsent); + print "Content-type: text/html; charset=utf-8\n\n" if (!$htmlhdrsent); $htmlhdrsent = 1; } @@ -246,6 +283,38 @@ sub CheckLatLong { } } +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 { @@ -257,11 +326,12 @@ sub ReadConfigFile { if ((!/^\s*#/) && ($_ ne "")) { # Chop off any trailing comments s/#.*//; - ($attr, $setting) = split(/=/, $_, 2); - $setting =~ s/"//g; + /([^=]+)=(.*)/; + ($attr, $setting) = ($1, $2); + $setting =~ s/"//g; #" $setting =~ s/;$//; - $attr =~ s/^ +//; $attr =~ s/ +$//; - $setting =~ s/^ +//; $setting =~ s/ +$//; + $attr =~ s/^\s+//; $attr =~ s/\s+$//; + $setting =~ s/^\s+//; $setting =~ s/\s+$//; $config{$attr} = $setting; } }