4885a78c1c
Add separate commdaemon script to control looping of basic script, and allow orderly shutdown. Add hook to client.pl script to interact properly with the new commmodule and commdaemon scripts.
1150 lines
28 KiB
Perl
Executable file
1150 lines
28 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
||
|
||
# CommModule - CAcert Communication Module
|
||
# Copyright (C) 2006-2009 CAcert Inc.
|
||
#
|
||
# This program is free software; you can redistribute it and/or modify
|
||
# it under the terms of the GNU General Public License as published by
|
||
# the Free Software Foundation; version 2 of the License.
|
||
#
|
||
# This program is distributed in the hope that it will be useful,
|
||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
# GNU General Public License for more details.
|
||
#
|
||
# You should have received a copy of the GNU General Public License
|
||
# along with this program; if not, write to the Free Software
|
||
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||
|
||
|
||
# Production Client / CommModule
|
||
|
||
use strict;
|
||
use Device::SerialPort qw( :PARAM :STAT 0.07 );
|
||
use POSIX;
|
||
use IO::Select;
|
||
use Time::HiRes q(usleep);
|
||
use File::CounterFile;
|
||
use IPC::Open3;
|
||
use File::Copy;
|
||
use DBI;
|
||
use Locale::gettext;
|
||
use IO::Socket;
|
||
use MIME::Base64;
|
||
use Digest::SHA1 qw(sha1_hex);
|
||
|
||
#Protocol version:
|
||
my $ver=1;
|
||
|
||
my $paranoid=1;
|
||
|
||
my $debug=0;
|
||
|
||
#my $serialport="/dev/ttyS0";
|
||
my $serialport="/dev/ttyUSB0";
|
||
|
||
my $gpgbin="/usr/bin/gpg";
|
||
|
||
my $opensslbin="/usr/bin/openssl";
|
||
|
||
|
||
my $mysqlphp="/home/cacert/www/includes/mysql.php";
|
||
|
||
my %revokefile=(2=>"../www/class3-revoke.crl",1=>"../www/revoke.crl");
|
||
|
||
my $newlayout=1;
|
||
|
||
#End of configurations
|
||
|
||
########################################################
|
||
|
||
|
||
my %monarr = ("Jan" => 1, "Feb" => 2, "Mar" => 3, "Apr" => 4, "May" => 5, "Jun" => 6, "Jul" => 7, "Aug" => 8, "Sep" => 9, "Oct" => 10, "Nov" => 11, "Dec" => 12);
|
||
|
||
|
||
my $password="";
|
||
if(open IN,"<$mysqlphp")
|
||
{
|
||
my $content="";
|
||
undef $/;
|
||
$content=<IN>;
|
||
$password=$1 if($content=~m/mysql_connect\s*\("[^"]+",\s*"\w+",\s*"(\w+)"/);
|
||
close IN;
|
||
$/="\n";
|
||
|
||
}
|
||
else
|
||
{
|
||
die "Could not read file: $!\n";
|
||
}
|
||
|
||
|
||
my $dbh = DBI->connect("DBI:mysql:cacert:localhost","cacert",$password, { RaiseError => 1, AutoCommit => 1 }) || die ("Error with the database connection.\n");
|
||
|
||
sub readfile($)
|
||
{
|
||
my $save=$/;
|
||
undef $/;
|
||
open READIN,"<$_[0]";
|
||
my $content=<READIN>;
|
||
close READIN;
|
||
$/=$save;
|
||
return $content;
|
||
}
|
||
|
||
|
||
|
||
#Logging functions:
|
||
my $lastdate = "";
|
||
|
||
sub SysLog($)
|
||
{
|
||
return if(not defined($_[0]));
|
||
my $timestamp = strftime("%Y-%m-%d %H:%M:%S", localtime);
|
||
my $currdate = substr($timestamp, 0, 10);
|
||
if ($lastdate ne $currdate) {
|
||
close LOG if ($lastdate ne "");
|
||
$lastdate = $currdate;
|
||
open LOG,">>logfile$lastdate.txt";
|
||
}
|
||
print LOG "$timestamp $_[0]";
|
||
flush LOG;
|
||
}
|
||
|
||
sub Error($)
|
||
{
|
||
SysLog($_[0]);
|
||
if($paranoid)
|
||
{
|
||
die $_[0];
|
||
}
|
||
}
|
||
|
||
|
||
my $timestamp=strftime("%Y-%m-%d %H:%M:%S",localtime);
|
||
|
||
#mkdir "revokehashes";
|
||
foreach (keys %revokefile)
|
||
{
|
||
next unless (-f $revokefile{$_});
|
||
my $revokehash=sha1_hex(readfile($revokefile{$_}));
|
||
SysLog "Root $_: Hash $revokefile{$_} = $revokehash";
|
||
}
|
||
|
||
|
||
|
||
sub mysql_query($)
|
||
{
|
||
$dbh->do($_[0]);
|
||
}
|
||
|
||
sub trim($)
|
||
{
|
||
my $new=$_[0];
|
||
$new=~s/^\s*//;
|
||
$new=~s/\s*$//;
|
||
return($new);
|
||
}
|
||
sub addslashes($)
|
||
{
|
||
my $new=$_[0];
|
||
$new=~s/['"\\]/\\$1/g;
|
||
return($new);
|
||
}
|
||
|
||
sub recode
|
||
{
|
||
return $_[1];
|
||
}
|
||
|
||
|
||
|
||
SysLog("Opening Serial interface:\n");
|
||
sub SerialSettings($)
|
||
{
|
||
my $PortObj=$_[0];
|
||
if(!defined($PortObj))
|
||
{
|
||
Error "Could not open Serial Port!\n" ;
|
||
}
|
||
else
|
||
{
|
||
$PortObj->baudrate(115200);
|
||
$PortObj->parity("none");
|
||
$PortObj->databits(8);
|
||
$PortObj->stopbits(1);
|
||
}
|
||
}
|
||
|
||
#We have to open the SerialPort and close it again, so that we can bind it to a Handle
|
||
if(! -f "serial.conf")
|
||
{
|
||
my $PortObj = new Device::SerialPort($serialport);
|
||
SerialSettings($PortObj);
|
||
$PortObj->save("serial.conf");
|
||
undef $PortObj;
|
||
}
|
||
|
||
my $PortObj = tie (*SER, 'Device::SerialPort', "serial.conf") || Error "Can't tie using Configuration_File_Name: $!\n";
|
||
|
||
Error "Could not open Serial Interface!\n" if(not defined($PortObj));
|
||
SerialSettings($PortObj);
|
||
#open SER,">$serialport";
|
||
|
||
SysLog("Serial interface opened: $PortObj\n");
|
||
|
||
my $sel = new IO::Select( \*SER );
|
||
|
||
|
||
|
||
#Hexdump function: Returns the hexdump representation of a string
|
||
sub hexdump($)
|
||
{
|
||
return "" if(not defined($_[0]));
|
||
my $content="";
|
||
$content.=sprintf("%02X ",unpack("C",substr($_[0],$_,1))) foreach (0 .. length($_[0])-1);
|
||
return $content;
|
||
}
|
||
|
||
#pack3 packs together the length of the data in 3 bytes and the data itself, size limited to 16MB. In case the data is more than 16 MB, it is ignored, and a 0 Byte block is transferred
|
||
sub pack3
|
||
{
|
||
return "\x00\x00\x00" if(!defined($_[0]));
|
||
my $data=(length($_[0]) >= 2**24)? "":$_[0];
|
||
my $len=pack("N",length($data));
|
||
SysLog "len: ".length($data)."\n" if($debug);
|
||
return substr($len,1,3).$data;
|
||
}
|
||
|
||
|
||
#unpack3 unpacks packed data.
|
||
sub unpack3($)
|
||
{
|
||
return undef if((not defined($_[0])) or length($_[0])<3);
|
||
#SysLog "hexdump: ".hexdump("\x00".substr($_[0],0,3))."\n";
|
||
my $len=unpack("N","\x00".substr($_[0],0,3));
|
||
#SysLog "len3: $len length(): ".length($_[0])." length()-3: ".(length($_[0])-3)."\n";
|
||
return undef if(length($_[0])-3 != $len);
|
||
return substr($_[0],3);
|
||
}
|
||
|
||
|
||
#unpack3array extracts a whole array of concatented pack3ed data.
|
||
sub unpack3array($)
|
||
{
|
||
my @retarr=();
|
||
if((not defined($_[0])) or length($_[0])<3)
|
||
{
|
||
SysLog "Begin of structure corrupt\n";
|
||
return ();
|
||
}
|
||
my $dataleft=$_[0];
|
||
while(length($dataleft)>=3)
|
||
{
|
||
#SysLog "hexdump: ".hexdump("\x00".substr($dataleft,0,3))."\n";
|
||
my $len=unpack("N","\x00".substr($dataleft,0,3));
|
||
#SysLog "len3: $len length(): ".length($dataleft)." length()-3: ".(length($dataleft)-3)."\n";
|
||
if(length($dataleft)-3 < $len)
|
||
{
|
||
SysLog "Structure cut off\n";
|
||
return ();
|
||
}
|
||
push @retarr, substr($dataleft,3,$len);
|
||
$dataleft=substr($dataleft,3+$len);
|
||
}
|
||
if(length($dataleft)!=0)
|
||
{
|
||
SysLog "End of structure cut off\n";
|
||
return ();
|
||
}
|
||
return @retarr;
|
||
}
|
||
|
||
|
||
#Raw send function over the Serial Interface (+debugging)
|
||
sub SendIt($)
|
||
{
|
||
return unless defined($_[0]);
|
||
SysLog "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n" if($debug);
|
||
my $data=$_[0];
|
||
my $runcount=0;
|
||
my $total=0;
|
||
my $mtu=30;
|
||
while(length($data))
|
||
{
|
||
my $iwrote=scalar($PortObj->write(substr($data,0,$mtu)))||0;
|
||
#usleep(270*$iwrote+9000); # On Linux, we have to wait to make sure it is being sent, and we dont loose any data.
|
||
$total+=$iwrote;
|
||
$data=substr($data,$iwrote);
|
||
if ($debug) {
|
||
print "i wrote: $iwrote total: $total left: ".length($data)."\n" if(!($runcount++ %10));
|
||
}
|
||
}
|
||
SysLog "Sent message.\n" if($debug);
|
||
# print "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n";
|
||
# foreach(0 .. length($_[0]))
|
||
# {
|
||
# $PortObj->write(substr($_[0],$_,1));
|
||
# }
|
||
|
||
}
|
||
|
||
|
||
my $modus=0;
|
||
my $cnt=0;
|
||
|
||
|
||
#Send data over the Serial Interface with handshaking:
|
||
sub SendHandshaked($)
|
||
{
|
||
SysLog "Shaking hands ...\n" if($debug);
|
||
SendIt("\x02");
|
||
|
||
Error "Handshake uncompleted. Connection lost2!\n" if(!scalar($sel->can_read(20)));
|
||
my $data="";
|
||
my $length=read SER,$data,1;
|
||
if($length && $data eq "\x10")
|
||
{
|
||
#print "OK ...\n";
|
||
my $xor=0;
|
||
foreach(0 .. length($_[0])-1)
|
||
{
|
||
#print "xor mit ".unpack("C",substr($_[0],$_,1))."\n";
|
||
$xor ^= unpack("C",substr($_[0],$_,1));
|
||
}
|
||
#print "XOR: $xor\n";
|
||
|
||
my $tryagain=1;
|
||
while($tryagain)
|
||
{
|
||
SendIt($_[0].pack("C",$xor)."rie4Ech7");
|
||
|
||
Error "Packet receipt was not confirmed in 5 seconds. Connection lost!\n" if(!scalar($sel->can_read(5)));
|
||
|
||
$data="";
|
||
$length=read SER,$data,1;
|
||
|
||
if($length && $data eq "\x10")
|
||
{
|
||
SysLog "Sent successfully!...\n";
|
||
$tryagain=0;
|
||
}
|
||
elsif($length && $data eq "\x11")
|
||
{
|
||
$tryagain=1;
|
||
}
|
||
else
|
||
{
|
||
Error "I cannot send! $length ".unpack("C",$data)."\n";
|
||
}
|
||
}
|
||
|
||
}
|
||
else
|
||
{
|
||
print "!Cannot send! $length \n";
|
||
Error "!Stopped sending.\n";
|
||
}
|
||
}
|
||
|
||
|
||
|
||
sub Receive
|
||
{
|
||
my $data="";
|
||
my @ready = $sel->can_read(120);
|
||
|
||
my $length=read SER,$data,1,0;
|
||
|
||
#SysLog "Data: ".hexdump($data)."\n";
|
||
|
||
if($data eq "\x02")
|
||
{
|
||
$modus=1;
|
||
SysLog "Start received, sending OK\n" if($debug);
|
||
SendIt("\x10");
|
||
|
||
my $block="";
|
||
my $blockfinished=0;
|
||
my $tries=100000;
|
||
|
||
while(!$blockfinished)
|
||
{
|
||
Error("Tried reading too often\n") if(($tries--)<=0);
|
||
# SysLog ("tries: $tries") if(!($tries%10));
|
||
|
||
$data="";
|
||
if(!scalar($sel->can_read(5)))
|
||
{
|
||
Error "Handshake uncompleted. Connection lost variant2!\n" ;
|
||
return;
|
||
}
|
||
$length=read SER,$data,100,0;
|
||
if($length)
|
||
{
|
||
$block.=$data;
|
||
}
|
||
#SysLog("Received: $length ".length($block)."\n");
|
||
$blockfinished=defined(unpack3(substr($block,0,-9)))?1:0;
|
||
|
||
if(!$blockfinished and substr($block,-8,8) eq "rie4Ech7")
|
||
{
|
||
SysLog "BROKEN Block detected!\n";
|
||
SendIt("\x11");
|
||
$block="";
|
||
$blockfinished=0;
|
||
$tries=100000;
|
||
}
|
||
|
||
}
|
||
SysLog "Block done: ".hexdump($block)."\n" if($debug);
|
||
SendIt("\x10");
|
||
return($block);
|
||
}
|
||
else
|
||
{
|
||
Error("Error: No Answer received, Timeout.\n") if(length($data)==0);
|
||
Error("Error: Wrong Startbyte: ".hexdump($data)." !\n");
|
||
}
|
||
|
||
SysLog "Waiting on next request ...\n";
|
||
|
||
}
|
||
|
||
|
||
|
||
# @result(Version,Action,Errorcode,Response)=Request(Version=1,Action=1,System=1,Root=1,Configuration="...",Parameter="...",Request="...");
|
||
sub Request($$$$$$$$$$$)
|
||
{
|
||
SysLog "Version: $_[0] Action: $_[1] System: $_[2] Root: $_[3] Config: $_[4]\n";
|
||
$_[3]=0 if($_[3]<0);
|
||
SendHandshaked(pack3(pack3(pack("C*",$_[0],$_[1],$_[2],$_[3],$_[4],$_[5],$_[6]>>8,$_[6]&255,$_[7])).pack3($_[8]).pack3($_[9]).pack3($_[10])));
|
||
my $data=Receive();
|
||
my @fields=unpack3array(substr($data,3,-9));
|
||
|
||
SysLog "Answer from Server: ".hexdump($data)."\n" if($debug);
|
||
|
||
#if(open OUT,">result.dat")
|
||
#{
|
||
# print OUT $data;
|
||
# close OUT;
|
||
#}
|
||
#else
|
||
#{
|
||
# SysLog "Could not write result: $!\n";
|
||
#}
|
||
return $fields[1];
|
||
}
|
||
|
||
|
||
sub calculateDays($)
|
||
{
|
||
if($_[0])
|
||
{
|
||
my @sum = $dbh->selectrow_array("select sum(`points`) as `total` from `notary` where `to`='".$_[0]."' group by `to`");
|
||
SysLog("Summe: $sum[0]\n") if($debug);
|
||
|
||
return ($sum[0]>=50)?730:180;
|
||
}
|
||
return 180;
|
||
}
|
||
|
||
sub X509extractSAN($)
|
||
{
|
||
my @bits = split("/", $_[0]);
|
||
my $SAN="";
|
||
my $newsubject="";
|
||
foreach my $val(@bits)
|
||
{
|
||
my @bit=split("=",$val);
|
||
if($bit[0] eq "subjectAltName")
|
||
{
|
||
$SAN.="," if($SAN ne "");
|
||
$SAN.= trim($bit[1]);
|
||
}
|
||
else
|
||
{
|
||
$newsubject .= "/".$val;
|
||
}
|
||
}
|
||
$newsubject=~s{^//}{/};
|
||
$newsubject=~s/[\n\r\t\x00"\\']//g;
|
||
$SAN=~s/[ \n\r\t\x00"\\']//g;
|
||
return($SAN,$newsubject);
|
||
}
|
||
|
||
sub X509extractExpiryDate($)
|
||
{
|
||
# TIMEZONE ?!?
|
||
my $data=`$opensslbin x509 -in "$_[0]" -noout -enddate`;
|
||
|
||
#notAfter=Aug 8 10:26:34 2007 GMT
|
||
if($data=~m/notAfter=(\w{2,4}) *(\d{1,2}) *(\d{1,2}:\d{1,2}:\d{1,2}) (\d{4}) GMT/)
|
||
{
|
||
my $date="$4-".$monarr{$1}."-$2 $3";
|
||
SysLog "Expiry Date found: $date\n" if($debug);
|
||
return $date;
|
||
}
|
||
else
|
||
{
|
||
SysLog "Expiry Date not found: $data\n";
|
||
}
|
||
return "";
|
||
}
|
||
|
||
sub CRLuptodate($)
|
||
{
|
||
return 0 unless(-f $_[0]);
|
||
my $data=`$opensslbin crl -in "$_[0]" -noout -lastupdate -inform der`;
|
||
SysLog "CRL: $data";
|
||
#lastUpdate=Aug 8 10:26:34 2007 GMT
|
||
# Is the timezone handled properly?
|
||
if($data=~m/lastUpdate=(\w{2,4}) *(\d{1,2}) *(\d{1,2}:\d{1,2}:\d{1,2}) (\d{4}) GMT/)
|
||
{
|
||
my $date=sprintf("%04d-%02d-%02d",$4,$monarr{$1},$2);
|
||
SysLog "CRL Issueing Date found: $date\n" if($debug);
|
||
my $compare = strftime("%Y-%m-%d", localtime);
|
||
SysLog "Comparing $date with $compare\n" if($debug);
|
||
return $date eq $compare;
|
||
}
|
||
else
|
||
{
|
||
SysLog "Expiry Date not found. Perhaps DER format is necessary? Hint: $data\n";
|
||
}
|
||
return 0;
|
||
}
|
||
|
||
|
||
sub X509extractSerialNumber($)
|
||
{
|
||
# TIMEZONE ?!?
|
||
my $data=`$opensslbin x509 -in "$_[0]" -noout -serial`;
|
||
if($data=~m/serial=([0-9A-F]+)/)
|
||
{
|
||
return $1;
|
||
}
|
||
return "";
|
||
}
|
||
|
||
sub OpenPGPextractExpiryDate ($)
|
||
{
|
||
my $r="";
|
||
my $cts;
|
||
my @date;
|
||
|
||
open(RGPG, $gpgbin.' -vv '.$_[0].' 2>&1 |') or Error('Can\'t start GnuPG($gpgbin): '.$!."\n");
|
||
open(OUT, '> infogpg.txt' ) or Error('Can\'t open output file: infogpg.txt: '.$!);
|
||
$/="\n";
|
||
while (<RGPG>)
|
||
{
|
||
print OUT $_;
|
||
unless ($r)
|
||
{
|
||
if ( /^\s*version \d+, created (\d+), md5len 0, sigclass \d+\s*$/ )
|
||
{
|
||
SysLog "Detected CTS: $1\n";
|
||
$cts = int($1);
|
||
} elsif ( /^\s*critical hashed subpkt \d+ len \d+ \(sig expires after ((\d+)y)?((\d+)d)?((\d+)h)?(\d+)m\)\s*$/ )
|
||
{
|
||
SysLog "Detected FRAME $2 $4 $6 $8\n";
|
||
$cts += $2 * 31536000; # secs per year (60 * 60 * 24 * 365)
|
||
$cts += $4 * 86400; # secs per day (60 * 60 * 24)
|
||
$cts += $6 * 3600; # secs per hour (60 * 60)
|
||
$cts += $8 * 60; # secs per min (60)
|
||
$r = $cts;
|
||
}
|
||
elsif(/version/)
|
||
{
|
||
SysLog "Detected VERSION\n";
|
||
}
|
||
}
|
||
}
|
||
|
||
close(OUT );
|
||
close(RGPG);
|
||
|
||
SysLog "CTS: $cts R: $r\n";
|
||
|
||
if ( $r )
|
||
{
|
||
@date = gmtime($r);
|
||
$r = sprintf('%.4i-%.2i-%.2i %.2i:%.2i:%.2i', # date format
|
||
$date[5] + 1900, $date[4] + 1, $date[3], # day
|
||
$date[2], $date[1], $date[0], # time
|
||
);
|
||
|
||
}
|
||
SysLog "$r\n";
|
||
return $r;
|
||
}
|
||
|
||
#sub OpenPGPextractExpiryDate($)
|
||
#{
|
||
# my $data=`$gpgbin -v $_[0]`;
|
||
# open OUT,">infogpg.txt";
|
||
# print OUT $data;
|
||
# close OUT;
|
||
# if($data=~m/^sig\s+[0-9A-F]{8} (\d{4}-\d\d-\d\d) [^\[]/)
|
||
# {
|
||
# return "$1 00:00:00";
|
||
# }
|
||
# return "";
|
||
#}
|
||
|
||
|
||
# Sets the locale according to the users preferred language
|
||
sub setUsersLanguage($)
|
||
{
|
||
my $lang="de_DE";
|
||
print "Searching for the language of the user $_[0]\n";
|
||
my @a=$dbh->selectrow_array("select language from users where id='".int($_[0])."'");
|
||
$lang = $1 if($a[0]=~m/(\w+_[\w.@]+)/);
|
||
|
||
SysLog "The users preferred language: $lang\n";
|
||
|
||
if($lang ne "")
|
||
{
|
||
$ENV{"LANG"}=$lang;
|
||
setlocale(LC_ALL, $lang);
|
||
} else {
|
||
$ENV{"LANG"}="en_AU";
|
||
setlocale(LC_ALL, "en_AU");
|
||
}
|
||
}
|
||
|
||
|
||
sub getUserData($)
|
||
{
|
||
return() unless($_[0]=~m/^\d+$/);
|
||
my $sth = $dbh->prepare("select * from users where id='$_[0]'");
|
||
$sth->execute();
|
||
#SysLog "USER DUMP:\n";
|
||
while ( my $rowdata = $sth->fetchrow_hashref() )
|
||
{
|
||
my %tmp=%{$rowdata};
|
||
#foreach (sort keys %tmp)
|
||
#{
|
||
#SysLog " $_ -> $tmp{$_}\n";
|
||
#}
|
||
return %tmp;
|
||
}
|
||
return ();
|
||
}
|
||
|
||
|
||
sub _($)
|
||
{
|
||
return gettext($_[0]);
|
||
}
|
||
|
||
sub sendmail($$$$$$$)
|
||
{
|
||
my ($to, $subject, $message, $from, $replyto, $toname, $fromname)=@_;
|
||
my $errorsto="returns\@cacert.org";
|
||
my $extra="";
|
||
|
||
|
||
# sendmail($user{email}, "[CAcert.org] Your GPG/PGP Key", $body, "support\@cacert.org", "", "", "CAcert Support");
|
||
my @lines=split("\n",$message);
|
||
$message = "";
|
||
foreach my $line (@lines)
|
||
{
|
||
$line = trim($line);
|
||
if($line eq ".")
|
||
{
|
||
$message .= " .\n";
|
||
} else
|
||
{
|
||
$message .= $line."\n";
|
||
}
|
||
}
|
||
|
||
$fromname = $from if($fromname eq "");
|
||
|
||
my @bits = split(",", $from);
|
||
$from = addslashes($bits['0']);
|
||
$fromname = addslashes($fromname);
|
||
|
||
my $smtp = IO::Socket::INET->new(PeerAddr => 'localhost:25');
|
||
$/="\n";
|
||
SysLog "SMTP: ".<$smtp>;
|
||
print $smtp "HELO hlin.cacert.org\r\n";
|
||
SysLog "SMTP: ".<$smtp>;
|
||
print $smtp "MAIL FROM: <returns\@cacert.org>\r\n";
|
||
SysLog "MAIL FROM: ".<$smtp>;
|
||
|
||
@bits = split(",", $to);
|
||
foreach my $user (@bits)
|
||
{
|
||
print $smtp "RCPT TO: <".trim($user).">\r\n";
|
||
SysLog "RCPT TO: ".<$smtp>;
|
||
}
|
||
print $smtp "DATA\r\n";
|
||
SysLog "DATA: ".<$smtp>;
|
||
|
||
print $smtp "X-Mailer: CAcert.org Website\r\n";
|
||
print $smtp "X-OriginatingIP: ".$ENV{"REMOTE_ADDR"}."\r\n";
|
||
print $smtp "Sender: $errorsto\r\n";
|
||
print $smtp "Errors-To: $errorsto\r\n";
|
||
if($replyto ne "")
|
||
{
|
||
print $smtp "Reply-To: $replyto\r\n";
|
||
}
|
||
else
|
||
{
|
||
print $smtp "Reply-To: $from\r\n";
|
||
}
|
||
print $smtp "From: $from ($fromname)\r\n";
|
||
print $smtp "To: $to\r\n";
|
||
my $newsubj=encode_base64(recode("html..utf-8", trim($subject)));
|
||
#SysLog("NewSubj: --".$newsubj."--\n") if($debug);
|
||
$newsubj=~s/\n*$//;
|
||
#SysLog("NewSubj: --".$newsubj."--\n") if($debug);
|
||
print $smtp trim($subject)=~m/[^a-zA-Z0-9 ,.\[\]\/-]/?"Subject: =?utf-8?B?$newsubj?=\r\n":"Subject: $subject\r\n";
|
||
print $smtp "Mime-Version: 1.0\r\n";
|
||
if($extra eq "")
|
||
{
|
||
print $smtp "Content-Type: text/plain; charset=\"utf-8\"\r\n";
|
||
print $smtp "Content-Transfer-Encoding: 8bit\r\n";
|
||
}
|
||
else
|
||
{
|
||
print $smtp "Content-Type: text/plain; charset=\"iso-8859-1\"\r\n";
|
||
print $smtp "Content-Transfer-Encoding: quoted-printable\r\n";
|
||
print $smtp "Content-Disposition: inline\r\n";
|
||
};
|
||
# print $smtp "Content-Transfer-Encoding: BASE64\r\n";
|
||
print $smtp "\r\n";
|
||
# print $smtp chunk_split(encode_base64(recode("html..utf-8", $message)))."\r\n.\r\n";
|
||
print $smtp recode("html..utf-8", $message)."\r\n.\r\n";
|
||
SysLog "ENDOFTEXT: ".<$smtp>;
|
||
print $smtp "QUIT\n";
|
||
SysLog "QUIT: ".<$smtp>;
|
||
close($smtp);
|
||
}
|
||
|
||
|
||
sub HandleCerts($$)
|
||
{
|
||
my $org=$_[0]?"org":"";
|
||
my $server=$_[1];
|
||
|
||
|
||
my $table=$org.($server?"domaincerts":"emailcerts");
|
||
|
||
SysLog "HandleCerts $table\n";
|
||
|
||
my $sth = $dbh->prepare("select * from $table where crt_name='' and csr_name!='' and warning<3");
|
||
$sth->execute();
|
||
#$rowdata;
|
||
while ( my $rowdata = $sth->fetchrow_hashref() )
|
||
{
|
||
my %row=%{$rowdata};
|
||
my $prefix=$org.($server?"server":"client");
|
||
my $short=int($row{'id'}/1000);
|
||
my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
|
||
$csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
|
||
SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
|
||
|
||
#my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
|
||
my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
|
||
my $dirname=$crtname; $dirname=~s/\/[^\/]*\.crt//;
|
||
mkdir $dirname,0777;
|
||
SysLog("New Layout: $crtname\n");
|
||
|
||
if($server)
|
||
{
|
||
#Weird SQL structure ...
|
||
my @sqlres=$dbh->selectrow_array("select memid from domains where id='".int($row{'domid'})."'");
|
||
$row{'memid'}=$sqlres[0];
|
||
SysLog("Fetched memid: $row{'memid'}\n") if($debug);
|
||
}
|
||
|
||
SysLog "Opening $csrname\n";
|
||
|
||
my $crt="";
|
||
|
||
my $profile=0;
|
||
|
||
# "0"=>"client.cnf",
|
||
# "1"=>"client-org.cnf",
|
||
# "2"=>"client-codesign.cnf",
|
||
# "3"=>"client-machine.cnf",
|
||
# "4"=>"client-ads.cnf",
|
||
# "5"=>"server.cnf",
|
||
# "6"=>"server-org.cnf",
|
||
# "7"=>"server-jabber.cnf",
|
||
# "8"=>"server-ocsp.cnf",
|
||
# "9"=>"server-timestamp.cnf",
|
||
# "10"=>"proxy.cnf",
|
||
# "11"=>"subca.cnf"
|
||
|
||
|
||
if($row{"type"} =~ m/^(8|9)$/)
|
||
{
|
||
$profile=$row{"type"};
|
||
}
|
||
elsif($org)
|
||
{
|
||
if($row{'codesign'})
|
||
{
|
||
$profile=2; ## TODO!
|
||
}
|
||
elsif($server)
|
||
{
|
||
$profile=6;
|
||
}
|
||
else
|
||
{
|
||
$profile=1;
|
||
}
|
||
}
|
||
else
|
||
{
|
||
if($row{'codesign'})
|
||
{
|
||
$profile=2;
|
||
}
|
||
elsif($server)
|
||
{
|
||
$profile=5;
|
||
}
|
||
else
|
||
{
|
||
$profile=0;
|
||
}
|
||
|
||
|
||
}
|
||
|
||
|
||
|
||
if(open(IN,"<$csrname"))
|
||
{
|
||
undef $/;
|
||
my $content=<IN>;
|
||
close IN;
|
||
SysLog "Read $csrname.\n" if($debug);
|
||
SysLog "Subject: --$row{'subject'}--\n" if($debug);
|
||
|
||
my ($SAN,$subject)=X509extractSAN($row{'subject'});
|
||
SysLog "Subject: --$subject--\n" if($debug);
|
||
SysLog "SAN: --$SAN--\n" if($debug);
|
||
SysLog "memid: $row{'memid'}\n" if($debug);
|
||
|
||
my $days=$org?($server?(365*2):365):calculateDays($row{"memid"});
|
||
|
||
|
||
$crt=Request($ver,1,1,$row{'rootcert'}-1,$profile,$row{'md'}eq"sha1"?2:0,$days,$row{'keytype'}eq"NS"?1:0,$content,$SAN,$subject);
|
||
if(length($crt))
|
||
{
|
||
if($crt=~m/^-----BEGIN CERTIFICATE-----/)
|
||
{
|
||
open OUT,">$crtname";
|
||
print OUT $crt;
|
||
close OUT;
|
||
}
|
||
else
|
||
{
|
||
open OUT,">$crtname.der";
|
||
print OUT $crt;
|
||
close OUT;
|
||
system "$opensslbin x509 -in $crtname.der -inform der -out $crtname";
|
||
}
|
||
}
|
||
else
|
||
{
|
||
SysLog "ZERO Length certificate received.\n";
|
||
}
|
||
}
|
||
else
|
||
{
|
||
print "Error: $! Konnte $csrname nicht laden\n";
|
||
}
|
||
|
||
|
||
|
||
if(-s $crtname)
|
||
{
|
||
SysLog "Opening $crtname\n";
|
||
|
||
my $date=X509extractExpiryDate($crtname);
|
||
my $serial=X509extractSerialNumber($crtname);
|
||
|
||
setUsersLanguage($row{memid});
|
||
|
||
my %user=getUserData($row{memid});
|
||
|
||
foreach (sort keys %user)
|
||
{
|
||
SysLog " $_ -> $user{$_}\n" if($debug);
|
||
}
|
||
|
||
SysLog("update `$table` set `crt_name`='$crtname', modified=now(), serial='$serial', `expire`='$date' where `id`='".$row{'id'}."'\n");
|
||
|
||
$dbh->do("update `$table` set `crt_name`='$crtname', modified=now(), serial='$serial', `expire`='$date' where `id`='".$row{'id'}."'");
|
||
|
||
my $body = _("Hi")." $user{fname},\n\n";
|
||
$body .= sprintf(_("You can collect your certificate for %s by going to the following location:")."\n\n", $row{'email'}.$row{'CN'});
|
||
$body .= "https://www.cacert.org/account.php?id=".($server?"15":"6")."&cert=$row{id}\n\n";
|
||
$body .= _("If you have not imported CAcert´s root certificate, please go to:")."\n";
|
||
$body .= "https://www.cacert.org/index.php?id=3\n";
|
||
$body .= "Root cert fingerprint = A6:1B:37:5E:39:0D:9C:36:54:EE:BD:20:31:46:1F:6B\n";
|
||
$body .= "Root cert fingerprint = 135C EC36 F49C B8E9 3B1A B270 CD80 8846 76CE 8F33\n\n";
|
||
$body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
|
||
sendmail($user{email}, "[CAcert.org] "._("Your certificate"), $body, "support\@cacert.org", "", "", "CAcert Support");
|
||
}
|
||
else
|
||
{
|
||
SysLog("Could not find the issued certificate. $crtname ".$row{"id"}."\n");
|
||
$dbh->do("update `$table` set warning=warning+1 where `id`='".$row{'id'}."'");
|
||
}
|
||
}
|
||
}
|
||
|
||
|
||
sub DoCRL($$)
|
||
{
|
||
my $crl=$_[0];
|
||
my $crlname=$_[1];
|
||
|
||
if(length($crl))
|
||
{
|
||
if($crl=~m/^-----BEGIN X509 CRL-----/)
|
||
{
|
||
open OUT,">$crlname.pem";
|
||
print OUT $crl;
|
||
close OUT;
|
||
system "$opensslbin crl -in $crlname.pem -outform der -out $crlname.tmp";
|
||
}
|
||
else
|
||
{
|
||
open OUT,">$crlname.patch";
|
||
print OUT $crl;
|
||
close OUT;
|
||
my $res=system "xdelta patch $crlname.patch $crlname $crlname.tmp";
|
||
#print "xdelta res: $res\n";
|
||
if($res==512)
|
||
{
|
||
open OUT,">$crlname.tmp";
|
||
print OUT $crl;
|
||
close OUT;
|
||
}
|
||
}
|
||
|
||
my $res=`openssl crl -verify -in $crlname.tmp -inform der -noout 2>&1`;
|
||
SysLog "verify: $res";
|
||
if($res=~m/verify OK/)
|
||
{
|
||
rename "$crlname.tmp","$crlname";
|
||
}
|
||
else
|
||
{
|
||
SysLog "VERIFICATION OF NEW CRL DID NOT SUCCEED! PLEASE REPAIR!";
|
||
SysLog "Broken CRL is available as $crlname.tmp\n";
|
||
#Override for testing:
|
||
rename "$crlname.tmp","$crlname";
|
||
}
|
||
return 1;
|
||
}
|
||
else
|
||
{
|
||
SysLog("RECEIVED AN EMPTY CRL!\n");
|
||
}
|
||
return 0;
|
||
}
|
||
|
||
|
||
sub RefreshCRLs()
|
||
{
|
||
foreach my $rootcert (keys %revokefile)
|
||
{
|
||
if(!CRLuptodate($revokefile{$rootcert}))
|
||
{
|
||
SysLog "Update of the CRL $rootcert is necessary!\n";
|
||
my $crlname = $revokefile{$rootcert};
|
||
my $revokehash=sha1_hex(readfile($crlname));
|
||
my $crl=Request($ver,2,1,$rootcert-1,0,0,365,0,"","",$revokehash);
|
||
#print "Received ".length($crl)." ".hexdump($crl)."\n";
|
||
DoCRL($crl,$crlname);
|
||
}
|
||
}
|
||
}
|
||
|
||
|
||
sub RevokeCerts($$)
|
||
{
|
||
my $org=$_[0]?"org":"";
|
||
my $server=$_[1];
|
||
|
||
my $table=$org.($server?"domaincerts":"emailcerts");
|
||
|
||
my $sth = $dbh->prepare("select * from $table where revoked='1970-01-01 10:00:01'"); # WHICH TIMEZONE?
|
||
$sth->execute();
|
||
#$rowdata;
|
||
while ( my $rowdata = $sth->fetchrow_hashref() )
|
||
{
|
||
my %row=%{$rowdata};
|
||
|
||
my $prefix=$org.($server?"server":"client");
|
||
my $short=int($row{'id'}/1000);
|
||
|
||
my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
|
||
$csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
|
||
SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
|
||
|
||
#my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
|
||
my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
|
||
SysLog("New Layout: $crtname\n");
|
||
|
||
#my $csrname = "../csr/".$org.($server?"server-":"client-").$row{'id'}.".csr";
|
||
#my $crtname = "../crt/".$org.($server?"server-":"client-").$row{'id'}.".crt";
|
||
my $crlname = $revokefile{$row{'rootcert'}};
|
||
|
||
my $crt="";
|
||
|
||
|
||
if(open(IN,"<$crtname"))
|
||
{
|
||
undef $/;
|
||
my $content=<IN>;
|
||
close IN;
|
||
my $revokehash=sha1_hex(readfile($crlname));
|
||
|
||
my $crl=Request($ver,2,1,$row{'rootcert'}-1,0,0,365,0,$content,"",$revokehash);
|
||
my $result=DoCRL($crl,$crlname);
|
||
|
||
if($result)
|
||
{
|
||
setUsersLanguage($row{memid});
|
||
|
||
my %user=getUserData($row{memid});
|
||
|
||
$dbh->do("update `$table` set `revoked`=now() where `id`='".$row{'id'}."'");
|
||
|
||
my $body = _("Hi")." $user{fname},\n\n";
|
||
$body .= sprintf(_("Your certificate for %s has been revoked, as per request.")."\n\n", $row{'CN'});
|
||
$body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
|
||
SysLog("Sending email to ".$user{"email"}."\n") if($debug);
|
||
sendmail($user{email}, "[CAcert.org] "._("Your certificate"), $body, "support\@cacert.org", "", "", "CAcert Support");
|
||
}
|
||
|
||
}
|
||
else
|
||
{
|
||
SysLog("Error in RevokeCerts: $crtname $!\n") if($debug);
|
||
}
|
||
|
||
}
|
||
|
||
}
|
||
|
||
|
||
|
||
|
||
sub HandleGPG()
|
||
{
|
||
my $sth = $dbh->prepare("select * from gpg where crt='' and csr!='' ");
|
||
$sth->execute();
|
||
my $rowdata;
|
||
while ( $rowdata = $sth->fetchrow_hashref() )
|
||
{
|
||
my %row=%{$rowdata};
|
||
|
||
my $prefix="gpg";
|
||
my $short=int($row{'id'}/1000);
|
||
my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
|
||
$csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
|
||
SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
|
||
|
||
#my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
|
||
my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
|
||
SysLog("New Layout: $crtname\n");
|
||
|
||
|
||
#my $csrname = "../csr/gpg-".$row{'id'}.".csr";
|
||
#my $crtname = "../crt/gpg-".$row{'id'}.".crt";
|
||
|
||
SysLog "Opening $csrname\n";
|
||
|
||
my $crt="";
|
||
|
||
if(-s $csrname && open(IN,"<$csrname"))
|
||
{
|
||
undef $/;
|
||
my $content=<IN>;
|
||
close IN;
|
||
SysLog "Read $csrname.\n";
|
||
$crt=Request($ver,1,2,0,0,2,366,0,$content,"","");
|
||
if(length($crt))
|
||
{
|
||
open OUT,">$crtname";
|
||
print OUT $crt;
|
||
close OUT;
|
||
}
|
||
|
||
}
|
||
else
|
||
{
|
||
#Error("Error: $!\n");
|
||
next;
|
||
}
|
||
|
||
if(-s $crtname)
|
||
{
|
||
SysLog "Opening $crtname\n";
|
||
setUsersLanguage($row{memid});
|
||
|
||
my $date=OpenPGPextractExpiryDate($crtname);
|
||
my %user=getUserData($row{memid});
|
||
|
||
$dbh->do("update `gpg` set `crt`='$crtname', issued=now(), `expire`='$date' where `id`='".$row{'id'}."'");
|
||
|
||
my $body = _("Hi")." $user{fname},\n\n";
|
||
$body .= sprintf(_("Your CAcert signed key for %s is available online at:")."\n\n", $row{'email'});
|
||
$body .= "https://www.cacert.org/gpg.php?id=3&cert=$row{id}\n\n";
|
||
$body .= _("To help improve the trust of CAcert in general, it's appreciated if you could also sign our key and upload it to a key server. Below is a copy of our primary key details:")."\n\n";
|
||
$body .= "pub 1024D/65D0FD58 2003-07-11 CA Cert Signing Authority (Root CA) <gpg\@cacert.org>\n";
|
||
$body .= "Key fingerprint = A31D 4F81 EF4E BD07 B456 FA04 D2BB 0D01 65D0 FD58\n\n";
|
||
$body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
|
||
sendmail($user{email}, "[CAcert.org] Your GPG/PGP Key", $body, "support\@cacert.org", "", "", "CAcert Support");
|
||
} else {
|
||
SysLog("Could not find the issued gpg key. ".$row{"id"}."\n");
|
||
#$dbh->do("delete from `gpg` where `id`='".$row{'id'}."'");
|
||
}
|
||
}
|
||
}
|
||
|
||
|
||
# Main program loop
|
||
|
||
my $crlcheck=0;
|
||
|
||
while ( -f "./client.pl-active" )
|
||
{
|
||
SysLog("Handling GPG database ...\n");
|
||
HandleGPG();
|
||
SysLog("Issueing certs ...\n");
|
||
HandleCerts(0,0); #personal client certs
|
||
HandleCerts(0,1); #personal server certs
|
||
HandleCerts(1,0); #org client certs
|
||
HandleCerts(1,1); #org server certs
|
||
SysLog("Revoking certs ...\n");
|
||
RevokeCerts(0,0); #personal client certs
|
||
RevokeCerts(0,1); #personal server certs
|
||
RevokeCerts(1,0); #org client certs
|
||
RevokeCerts(1,1); #org server certs
|
||
|
||
$crlcheck++;
|
||
RefreshCRLs() if(($crlcheck%100) == 1);
|
||
|
||
#print "Sign Request X.509, Root0\n";
|
||
#my $reqcontent="";
|
||
#Request($ver,1,1,0,5,2,365,0,$reqcontent,"","/CN=supertest.cacert.at");
|
||
|
||
SysLog("NUL Request:\n");
|
||
my $timestamp=strftime("%m%d%H%M%Y.%S",gmtime);
|
||
Request($ver,0,0,0,0,0,0,0,$timestamp,"","");
|
||
sleep(1);
|
||
usleep(1700000);
|
||
}
|