X-Git-Url: https://git.adam-barratt.org.uk/?a=blobdiff_plain;ds=sidebyside;f=Util.pm;h=001de372e5e232fc5637a0995cd30a107d35af0d;hb=c1a1f0ea0c39ccc084f590bd25331c071f7849eb;hp=1688dc4d8078c85ff11a87f1267885225765a10d;hpb=a1750087e17caa3ec1baeafc21b1a5229979df38;p=mirror%2Fuserdir-ldap-cgi.git
diff --git a/Util.pm b/Util.pm
index 1688dc4..001de37 100644
--- a/Util.pm
+++ b/Util.pm
@@ -1,8 +1,14 @@
# -*- 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 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";
@@ -222,16 +228,21 @@ sub FormatLastSeen {
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);
+ ($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+"<(.+?)>"/);
+ 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";
}
@@ -339,4 +350,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;