X-Git-Url: https://git.adam-barratt.org.uk/?a=blobdiff_plain;ds=sidebyside;f=Util.pm;h=27060d703c80000cd78b748590e095f19cdcd1a5;hb=5af802ebb0c5e118c76a70e2b6100e7d0c0d0935;hp=89ef3fb8c6a982a94ff150bd910a61cd12015e1d;hpb=a6e49f39cdff3079e4d70b88b1ae4736f37a2176;p=mirror%2Fuserdir-ldap-cgi.git
diff --git a/Util.pm b/Util.pm
index 89ef3fb..27060d7 100644
--- a/Util.pm
+++ b/Util.pm
@@ -1,15 +1,27 @@
# -*- perl -*-x
+
+# Copyright (c) 1999-2006 Debian Admin Team Members and Developers (taken from debian/copyright in 2008 by weasel)
+# Copyright (c) 2002, 2003, 2004, 2008 Peter Palfrader
+
package Util;
use strict;
-use Crypt::Blowfish;
+use Date::Manip qw(ParseDate);
+use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);
+use English;
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;
@@ -21,21 +33,26 @@ sub CreateKey {
}
sub CreateCryptSalt {
+ # CreateCryptSalt(type = 0, skip_header = 0)
# this can create either a DES type salt or a MD5 salt
+ # 0 for DES, 1 for MD5 salt
+ # if skip_header is 0, does not add $1$ for md5 salts.
my $md5 = shift; # do we want a MD5 salt?
+ my $no_crypttype_header = shift;
my $validstr = './0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
my @valid = split(//,$validstr);
my ($in, $out);
-
+
my $cryptsaltlen = ($md5 ? 8 : 2);
-
+
open (F, "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 +77,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 +130,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 +182,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 +202,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 +224,33 @@ 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 = $lastseenpgp;
+ $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);
+ $date = CGI::escapeHTML($date);
+ $user = CGI::escapeHTML($user);
+ $list = CGI::escapeHTML($list);
+ $msgid = CGI::escapeHTML($msgid);
+ return "$date $list
Message ID: $msgid";
+}
+
sub LookupCountry {
my $in = shift;
my ($abbrev, $country);
@@ -220,7 +273,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 +299,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 +342,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;
}
}
@@ -269,4 +355,135 @@ sub ReadConfigFile {
return %config;
}
+sub UpgradeConnection($) {
+ my ($ldap) = @_;
+ my $mesg = $ldap->start_tls(
+ verify => 'require',
+ cafile => '/etc/ssl/certs/spi-cacert-2008.pem'
+ );
+ $mesg->sync;
+ if ($mesg->code != LDAP_SUCCESS) {
+ print "Content-type: text/html; charset=utf-8\n\n";
+ print "STARTTLS failed: ".$mesg->error."
\n";
+ exit(1);
+ };
+};
+
+sub readwrite3($$$$) {
+ my ($in, $inputfd, $stdoutfd, $stderrfd) = @_;
+
+ #Echolot::Log::trace("Entering readwrite_gpg.");
+
+ local $INPUT_RECORD_SEPARATOR = undef;
+ my $sout = IO::Select->new();
+ my $sin = IO::Select->new();
+ my $offset = 0;
+
+ #Echolot::Log::trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
+
+ $inputfd->blocking(0);
+ $stdoutfd->blocking(0);
+ $stderrfd->blocking(0);
+ $sout->add($stdoutfd);
+ $sout->add($stderrfd);
+ $sin->add($inputfd);
+
+ my ($stdout, $stderr) = ("", "", "");
+
+ my ($readyr, $readyw);
+ while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
+ #Echolot::Log::trace("select waiting for ".($sout->count())." fds.");
+ ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, 42);
+ #Echolot::Log::trace("ready: write: ".(defined $readyw ? scalar @$readyw : 'none')."; read: ".(defined $readyr ? scalar @$readyr : 'none'));
+ for my $wfd (@$readyw) {
+ #Echolot::Log::trace("writing to $wfd.");
+ my $written = 0;
+ if ($offset != length($in)) {
+ $written = $wfd->syswrite($in, length($in) - $offset, $offset);
+ }
+ unless (defined ($written)) {
+ #Echolot::Log::warn("Error while writing to GnuPG: $!");
+ close $wfd;
+ $sin->remove($wfd);
+ $sin = undef;
+ } else {
+ $offset += $written;
+ if ($offset == length($in)) {
+ #Echolot::Log::trace("writing to $wfd done.");
+ close $wfd;
+ $sin->remove($wfd);
+ $sin = undef;
+ }
+ }
+ }
+
+ next unless (defined(@$readyr)); # Wait some more.
+
+ for my $rfd (@$readyr) {
+ if ($rfd->eof) {
+ #Echolot::Log::trace("reading from $rfd done.");
+ $sout->remove($rfd);
+ close($rfd);
+ next;
+ }
+ #Echolot::Log::trace("reading from $rfd.");
+ if ($rfd == $stdoutfd) {
+ $stdout .= <$rfd>;
+ next;
+ }
+ if ($rfd == $stderrfd) {
+ $stderr .= <$rfd>;
+ next;
+ }
+ }
+ }
+ #Echolot::Log::trace("readwrite_gpg done.");
+ return ($stdout, $stderr);
+};
+
+sub checkPasswordQuality($$$) {
+ my ($pw, $oldpw, $ldapelements) = @_;
+ my ($stdinR, $stdinW) = (IO::Handle->new(), IO::Handle->new());
+ my ($stdoutR, $stdoutW) = (IO::Handle->new(), IO::Handle->new());
+ my ($stderrR, $stderrW) = (IO::Handle->new(), IO::Handle->new());
+ pipe $stdinR, $stdinW;
+ pipe $stdoutR, $stdoutW;
+ pipe $stderrR, $stderrW;
+
+ my $pid = fork();
+ unless (defined $pid) {
+ return (2, "Could not fork: $!");
+ };
+ unless ($pid) { # child
+ $stdinW->close;
+ $stdoutR->close;
+ $stderrR->close;
+ close STDIN;
+ close STDOUT;
+ close STDERR;
+ open (STDIN, "<&".$stdinR->fileno) or warn ("Cannot dup stdinR (fd ".$stdinR->fileno.") as STDIN: $!");
+ open (STDOUT, ">&".$stdoutW->fileno) or warn ("Cannot dup stdoutW (fd ".$stdoutW->fileno.") as STDOUT: $!");
+ open (STDERR, ">&".$stderrW->fileno) or warn ("Cannot dup stderrW (fd ".$stderrW->fileno.") as STDERR: $!");
+ { exec('/usr/lib/userdir-ldap-cgi/password-qualify-check'); }
+ $stderrW->print("Could not exec password-qualify-check: $!\n");
+ exit(1);
+ };
+ $stdinR->close;
+ $stdoutW->close;
+ $stderrW->close;
+
+ $oldpw = '' unless defined $oldpw;
+ my $out = join("\n", $pw, $oldpw, @$ldapelements)."\n";
+ my ($stdout, $stderr) = readwrite3($out, $stdinW, $stdoutR, $stderrR);
+ waitpid $pid, 0;
+
+ my $exitcode = $? >> 8;
+ if ($exitcode == 0 && $stdout eq '' && $stderr eq '') {
+ return (0, "ok");
+ } elsif ($exitcode == 1 && $stderr eq '') {
+ return (1, $stdout);
+ } else {
+ return (2, "check exited with exit code $exitcode, said '$stdout' on stdout, and '$stderr' on stderr.");
+ };
+};
1;