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 = "/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;
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;
}
# 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;
}
}
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 _
sub FetchKey {
my $fingerprint = shift;
- my ($out, $keyringparam);
+ my ($out, $keyringparam) = undef;
foreach (split(/:/, $config{keyrings})) {
$keyringparam .= "--keyring $_ ";
$fingerprint = "0x".$fingerprint;
$/ = undef; # just suck it up ....
- open(FP, "$config{gpg} $keyringparam --list-sigs --fingerprint $fingerprint|");
+ open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --list-sigs --fingerprint $fingerprint|");
$out = <FP>;
close FP;
- open(FP, "$config{gpg} $keyringparam --export -a $fingerprint|");
+ open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --export -a $fingerprint|");
$out .= <FP>;
close FP;
$/ = "\n";
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 <joeyh@debian.org>" "<debian-boot@lists.debian.org> archive/latest/7130" "<20000110181924.H19910@kitenet.net>"
+# [Mon, 10 Jan 2000 21:48:19] "9E1E 1052 F8BB A351 0606 5527 50BB 2974 2D59 A7D2" "<debian-devel-changes@lists.debian.org> archive/latest/58632" "<20000110200506.13257.qmail@master.debian.org>"
+ my $lastseenpgp = shift;
+ my $lastseenfrom = shift;
+ my ($d1, $d2, $lastseen);
+
+ return "<b>No activity detected</b>" 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<br> Message ID: $msgid";
+}
+
sub LookupCountry {
my $in = shift;
my ($abbrev, $country);
}
}
+sub FixParams {
+ my $query = shift;
+ my $key;
+ my @names = $query->param;
+
+ foreach $key (@names) { # web security is a joke ... <sigh>
+ $_ = $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 {
# Chop off any trailing comments
s/#.*//;
($attr, $setting) = split(/=/, $_, 2);
- $setting =~ s/"//g;
+ $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;
}
}