summaryrefslogtreecommitdiff
path: root/CommModule
diff options
context:
space:
mode:
Diffstat (limited to 'CommModule')
-rwxr-xr-xCommModule/client.pl4
-rw-r--r--CommModule/readme.txt1
-rwxr-xr-xCommModule/server.pl1045
3 files changed, 1048 insertions, 2 deletions
diff --git a/CommModule/client.pl b/CommModule/client.pl
index 7b417d1..4e09c46 100755
--- a/CommModule/client.pl
+++ b/CommModule/client.pl
@@ -670,13 +670,13 @@ sub sendmail($$$$$$$)
SysLog "SMTP: ".<$smtp>;
print $smtp "HELO hlin.cacert.org\r\n";
SysLog "SMTP: ".<$smtp>;
- print $smtp "MAIL FROM: <returns\@cacert.org>\r\n";
+ 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";
+ print $smtp "RCPT TO:<".trim($user).">\r\n";
SysLog "RCPT TO: ".<$smtp>;
}
print $smtp "DATA\r\n";
diff --git a/CommModule/readme.txt b/CommModule/readme.txt
index d832491..94f09fe 100644
--- a/CommModule/readme.txt
+++ b/CommModule/readme.txt
@@ -3,4 +3,5 @@ commdaemon Script to run client.pl or server.pl
commmodule Script for startup/shutdown of CommModule from /etc/init.d
logclean.sh Maintenance script for logfiles generated by CommModule
serial.conf Serial Port configuration file
+server.pl The real server, running on the signing server
usbclient.pl Obsoleted USB version of client.pl above
diff --git a/CommModule/server.pl b/CommModule/server.pl
new file mode 100755
index 0000000..eb5113a
--- /dev/null
+++ b/CommModule/server.pl
@@ -0,0 +1,1045 @@
+#!/usr/bin/perl -w
+
+# (c) 2006-2007 by CAcert.org
+
+# Server (running on the certificate machine)
+
+use strict;
+use Device::SerialPort qw( :PARAM :STAT 0.07 );
+use POSIX;
+use IO::Select;
+use File::CounterFile;
+use Time::HiRes q(usleep);
+use IPC::Open3;
+use File::Copy;
+use Digest::SHA1 qw(sha1_hex);
+
+#Protocol version:
+my $ver=1;
+
+my $debug=0;
+
+my $paranoid=1;
+
+my $serialport="/dev/ttyUSB0";
+#my $serialport="/dev/ttyS0";
+
+my $CPSUrl="http://www.cacert.org/cps.php";
+
+my $OCSPUrl="http://ocsp.cacert.org/";
+
+my $gpgbin="/usr/bin/gpg";
+
+my $opensslbin="/usr/bin/openssl";
+
+my $work="./work";
+
+#my $gpgID='gpgtest@cacert.at';
+my $gpgID='gpg@cacert.org';
+
+
+my %PkiSystems=(
+"1"=>"X.509",
+"2"=>"OpenPGP");
+my %rootkeys=(
+"1"=>5, #X.509
+"2"=>1);#OpenPGP
+my %hashes=(
+"0"=>"",
+"1"=>"-md md5",
+"2"=>"-md sha1",
+"3"=>"-md rmd160",
+"8"=>"-md sha256",
+"9"=>"-md sha384",
+"10"=>"-md sha512");
+my %templates=(
+ "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"=>"ocsp.cnf",
+ "9"=>"timestamp.cnf",
+ "10"=>"proxy.cnf",
+ "11"=>"subca.cnf"
+);
+
+my $starttime=5*60; # 5 minutes
+
+my %currenthash=();
+
+
+#End of configurations
+
+########################################################
+
+mkdir "$work",0700;
+mkdir "currentcrls";
+
+$ENV{'PATH'}='/usr/bin/:/bin';
+$ENV{'IFS'}="\n";
+$ENV{'LD_PRELOAD'}='';
+$ENV{'LD_LIBRARY_PATH'}='';
+$ENV{'LANG'}='';
+
+#Logging functions:
+sub SysLog($)
+{
+ my $date=strftime("%Y-%m-%d",localtime);
+ open LOG,">>logfile$date.txt";
+ return if(not defined($_[0]));
+ my $timestamp=strftime("%Y-%m-%d %H:%M:%S",localtime);
+ #$syslog->write($_[0]."\x00");
+ print LOG "$timestamp $_[0]";
+# print "$timestamp $_[0]";
+ flush LOG;
+ close LOG;
+}
+
+sub Error($)
+{
+ SysLog($_[0]);
+ if($paranoid)
+ {
+ die $_[0];
+ }
+}
+
+sub readfile($)
+{
+ my $olds=$/;
+ open READIN,"<$_[0]";
+ undef $/;
+ my $content=<READIN>;
+ close READIN;
+ $/=$olds;
+ return $content;
+}
+
+
+#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));
+ #print "len: ".length($data)."\n";
+ return substr($len,1,3).$data;
+}
+
+
+#unpack3 unpacks packed data.
+sub unpack3($)
+{
+ return undef if((not defined($_[0])) or length($_[0])<3);
+ #print "hexdump: ".hexdump("\x00".substr($_[0],0,3))."\n";
+ my $len=unpack("N","\x00".substr($_[0],0,3));
+ #print "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 packed data.
+sub unpack3array($)
+{
+ my @retarr=();
+ if((not defined($_[0])) or length($_[0])<3)
+ {
+ SysLog "Datenanfang kaputt\n";
+ return ();
+ }
+ my $dataleft=$_[0];
+ while(length($dataleft)>=3)
+ {
+ #print "hexdump: ".hexdump("\x00".substr($dataleft,0,3))."\n";
+ my $len=unpack("N","\x00".substr($dataleft,0,3));
+ #print "len3: $len length(): ".length($dataleft)." length()-3: ".(length($dataleft)-3)."\n";
+ if(length($dataleft)-3 < $len)
+ {
+ SysLog "Datensatz abgeschnitten\n";
+ return ();
+ }
+ push @retarr, substr($dataleft,3,$len);
+ $dataleft=substr($dataleft,3+$len);
+ }
+ if(length($dataleft)!=0)
+ {
+ SysLog "Ende abgeschnitten\n";
+ return ();
+ }
+ return @retarr;
+}
+
+
+
+
+my $timestamp=strftime("%Y-%m-%d %H:%M:%S",localtime);
+
+SysLog("Starting Server at $timestamp\n");
+
+SysLog("Opening Serial interface:\n");
+#if(1)
+#{
+
+sub SerialSettings
+{
+ my $PortObj=$_[0];
+ Error "Could not open Serial Port!\n" if(!defined($PortObj));
+ $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
+my $PortObj = new Device::SerialPort($serialport);
+SerialSettings($PortObj);
+$PortObj->save("serialserver.conf");
+#}
+undef $PortObj;
+
+$PortObj = tie (*SER, 'Device::SerialPort', "serialserver.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");
+
+
+#Creating select() selector for improved reading:
+my $sel = new IO::Select( \*SER );
+
+#Raw send function over the Serial Interface (+debugging)
+sub SendIt($)
+{
+ return unless defined($_[0]);
+ SysLog "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n";
+ 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);
+ print "i wrote: $iwrote total: $total left: ".length($data)."\n" if(!($runcount++ %10));
+ }
+
+# print "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n";
+# foreach(0 .. length($_[0]))
+# {
+# $PortObj->write(substr($_[0],$_,1));
+# }
+
+}
+
+
+#Send data over the Serial Interface with handshaking:
+#Warning: This function is implemented paranoid. It exits the program in case something goes wrong.
+sub SendHandshakedParanoid($)
+{
+ #print "Shaking hands ...\n";
+ SendIt("\x02");
+
+ Error "Handshake uncompleted. Connection lost!" if(!scalar($sel->can_read(2)));
+ my $data="";
+ usleep(1000000);
+ 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!" 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 $data\n";
+ Error "!Stopped sending.\n";
+ }
+}
+
+sub Receive
+{
+ my $data="";
+ my @ready = $sel->can_read(20);
+
+ my $length=read SER,$data,1,0;
+
+ #SysLog "Data: ".hexdump($data)."\n";
+
+ if($data eq "\x02")
+ {
+ my $modus=1;
+ SysLog "Start received, sending OK\n";
+ SendIt("\x10");
+
+ my $block="";
+ my $blockfinished=0;
+ my $tries=10000;
+
+ while(!$blockfinished)
+ {
+ Error("Tried reading too often\n") if(($tries--)<=0);
+
+ $data="";
+ if(!scalar($sel->can_read(2)))
+ {
+ SysLog("Timeout!\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!";
+ SendIt("\x11");
+ $block="";
+ $blockfinished=0;
+ $tries=10000;
+ }
+
+ }
+ SysLog "Block done: \n";#.hexdump($block)."\n";
+ SendIt("\x10");
+ SysLog "Returning block\n";
+ 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";
+
+}
+
+
+#Checks the CRC of a received block for validity
+#Returns 1 upon successful check and 0 for a failure
+sub CheckCRC($)
+{
+ my $block=$_[0];
+ return 0 if(length($_[0])<1);
+ return 1 if($_[0] eq "\x00");
+ my $xor=0;
+ foreach(0 .. length($block)-2)
+ {
+ #print "xor mit ".unpack("C",substr($block,$_,1))."\n";
+ $xor ^= unpack("C",substr($block,$_,1));
+ }
+ #print "XOR: $xor BCC: ".unpack("C",substr($block,-1,1))."\n";
+ if($xor eq unpack("C",substr($block,-1,1)))
+ {
+ #print "Checksum correct\n";
+ return 1;
+ }
+ else
+ {
+ #print "Checksum on received packet wrong!\n";
+ return 0;
+ }
+
+}
+
+#Formatting and sending a Response packet
+sub Response($$$$$$$)
+{
+ SendHandshakedParanoid(pack3(pack3(pack("C*",$_[0],$_[1],$_[2],$_[3])).pack3($_[4]).pack3($_[5]).pack3($_[6])));
+}
+
+
+#Checks the parameters, whether the certificate system (OpenPGP, X.509, ...) is available,
+#whether the specified root key is available, whether the config file is available, ...
+#Returns 1 upon success, and dies upon error!
+sub CheckSystem($$$$)
+{
+ my ($system,$root,$template,$hash)=@_;
+ if(not defined($templates{$template}))
+ {
+ Error "Template unknown!\n";
+ }
+ if(not defined($hashes{$hash}))
+ {
+ Error "Hash algorithm unknown!\n";
+ }
+ if(defined($rootkeys{$system}))
+ {
+ if($root<$rootkeys{$system})
+ {
+ return 1;
+ }
+ else
+ {
+ Error "Identity System $system has only $rootkeys{$system} root keys, key $root does not exist.\n";
+ }
+ }
+ else
+ {
+ Error "Identity System $system not supported";
+ }
+
+ return 0;
+}
+
+
+#Selects the specified config file for OpenSSL and makes sure that the specified config file exists
+#Returns the full path to the config file
+sub X509ConfigFile($$)
+{
+ my ($root,$template)=@_;
+ my $opensslcnf="";
+ if($root==0)
+ {
+ $opensslcnf="/etc/ssl/openssl-$templates{$template}";
+ }
+ elsif($root==1)
+ {
+ $opensslcnf="/etc/ssl/class3-$templates{$template}";
+ }
+ elsif($root==2)
+ {
+ $opensslcnf="/etc/ssl/class3s-$templates{$template}";
+ }
+ else
+ {
+ $opensslcnf="/etc/ssl/root$root/$templates{$template}";
+ }
+ # Check that the config file exists
+ Error "Config file does not exist: $opensslcnf!" unless (-f $opensslcnf);
+
+ return $opensslcnf;
+}
+
+sub CreateWorkspace()
+{
+ mkdir "$work",0700;
+ my $id = (new File::CounterFile "./$work/.counter", "0")->inc;
+ mkdir "$work/".int($id/1000),0700;
+ mkdir "$work/".int($id/1000)."/".($id%1000),0700;
+ my $wid="$work/".int($id/1000)."/".($id%1000);
+ SysLog "Creating Working directory: $wid\n";
+ return $wid;
+}
+
+
+sub SignX509($$$$$$$$)
+{
+ my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
+
+ my $wid=CreateWorkspace();
+
+ my $opensslcnf=X509ConfigFile($root,$template);
+
+ print "Subject: $subject\n";
+ print "SAN: $san\n";
+
+
+ $subject=~ s/\\x([A-F0-9]{2})/pack("C", hex($1))/egi;
+ $san=~ s/\\x([A-F0-9]{2})/pack("C", hex($1))/egi;
+
+ Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00"'\\]/);
+ Error "Invalid characters in Subject: ".hexdump($subject)." - $subject\n" if($subject=~m/[\n\r\t\x00"'\\]/);
+
+ print "Subject: $subject\n";
+ print "SAN: $san\n";
+
+ my $extfile="";
+ if($templates{$template}=~m/server/) #??? Should we really do that for all and only for server certs?
+ {
+ open OUT,">$wid/extfile";
+ print OUT "basicConstraints = critical, CA:FALSE\n";
+ print OUT "extendedKeyUsage = clientAuth, serverAuth, nsSGC, msSGC\n";
+ print OUT "keyUsage = digitalSignature, keyEncipherment\n";
+ print OUT "authorityInfoAccess = OCSP;URI:$OCSPUrl\n";
+ print OUT "subjectAltName = $san\n" if(length($san));
+ close OUT;
+ $extfile=" -extfile $wid/extfile ";
+ }
+
+ my $cmd=($request=~m/SPKAC\s*=/)?"-spkac":"-subj '$subject' -in";
+
+ #my $cmd=$spkac?"-spkac":"-subj '$subject' -in";
+
+
+ if(open OUT,">$wid/request.csr")
+ {
+ print OUT $request;
+ close OUT;
+
+ my $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf $cmd $wid/request.csr -out $wid/output.crt -days $days -key test -batch $extfile 2>&1`;
+
+ SysLog $do;
+
+
+ if(open IN,"<$wid/output.crt")
+ {
+ undef $/;
+ my $content=<IN>;
+ close IN;
+ $/="\n";
+
+ $content=~s/^.*-----BEGIN/-----BEGIN/s;
+ SysLog "Antworte...\n";
+ Response($ver,1,0,0,$content,"","");
+ SysLog "Done.\n";
+ if(!$debug)
+ {
+ unlink "$wid/output.crt";
+ unlink "$wid/request.csr";
+ unlink "$wid/extfile";
+ }
+ }
+ else
+ {
+ Error("Could not read the resulting certificate.\n");
+ }
+ }
+ else
+ {
+ Error("Could not save request.\n");
+ }
+ unlink "$wid";
+}
+
+sub SignOpenPGP
+{
+ my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
+
+ my $wid=CreateWorkspace();
+
+ if(! -f "secring$root.gpg")
+ {
+ Error "Root Key not found: secring$root.gpg !\n";
+ }
+
+ copy("secring$root.gpg","$wid/secring.gpg");
+ copy("pubring$root.gpg","$wid/pubring.gpg");
+
+ my $keyid=undef;
+
+ Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00"'\\]/);
+ Error "Invalid characters in Subject!\n" if($subject=~m/[ \n\r\t\x00"'\\;]/);
+
+
+ if(open OUT,">$wid/request.key")
+ {
+ print OUT $request;
+ close OUT;
+
+
+#!!!! ?!?
+ #my $homedir=-w "/root/.gnupg" ? "/root/.gnupg":"$wid/";
+ my $homedir="$wid/";
+
+ {
+ SysLog "Running GnuPG in $homedir...\n";
+ my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
+
+
+ SysLog "Importiere $gpgbin --no-tty --homedir $homedir --import $wid/request.key\n";
+
+ my $pid = open3($stdin,$stdout,$stderr, "$gpgbin --no-tty --homedir $homedir --command-fd 0 --status-fd 1 --logger-fd 2 --with-colons --import $wid/request.key");
+
+ if (!$pid) {
+ Error "Cannot fork GnuPG.";
+ }
+ $/="\n";
+ while(<$stdout>)
+ {
+ SysLog "Received from GnuPG: $_\n";
+ if(m/^\[GNUPG:\] GOT_IT/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.setpref\.okay/)
+ {
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] ALREADY_SIGNED/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] GOOD_PASSPHRASE/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] KEYEXPIRED/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] SIGEXPIRED/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] IMPORT_OK/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] IMPORT_RES/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] IMPORTED ([0-9A-F]{16})/)
+ {
+ Error "More than one OpenPGP sent at once!" if(defined($keyid));
+ $keyid=$1;
+ }
+ elsif(m/^\[GNUPG:\] NODATA/)
+ {
+ # To crash or not to crash, thats the question.
+ }
+ else
+ {
+ Error "ERROR: UNKNOWN $_\n";
+ }
+
+ }
+
+ while(<$stderr>)
+ {
+
+ SysLog "Received from GnuPG on stderr: $_\n";
+
+ if(m/^key ([0-9A-F]{8}): public key/)
+ {
+ #$keyid=$1;
+ }
+ }
+
+ waitpid($pid,0);
+
+ }
+
+ Error "No KeyID found!" if(!defined($keyid));
+
+
+ SysLog "Running GnuPG to Sign...\n";
+
+ {
+ my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
+
+
+
+ $ENV{'LANG'}="";
+
+ my $line="$gpgbin --no-tty --default-key $gpgID --homedir $homedir --default-cert-expire $days"."d --ask-cert-expire --cert-policy-url $CPSUrl --command-fd 0 --status-fd 1 --logger-fd 2 --sign-key $keyid ";
+ SysLog($line."\n");
+
+ my $pid = open3($stdin,$stdout,$stderr,$line);
+
+ if (!$pid) {
+ Error "Cannot fork GnuPG.";
+ }
+ SysLog "Got PID $pid\n";
+ while(<$stdout>)
+ {
+ SysLog "Received from GnuPG: $_\n";
+ if(m/^\[GNUPG:\] GET_BOOL keyedit\.sign_all\.okay/)
+ {
+ print $stdin "yes\n";
+ }
+ elsif(m/^\[GNUPG:\] GOT_IT/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.okay/)
+ {
+ print $stdin "yes\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.expire_okay/)
+ {
+ print $stdin "yes\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_LINE siggen\.valid\s?$/)
+ {
+ print $stdin "$days\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_LINE sign_uid\.expire\s?$/)
+ {
+ print "DETECTED: Do you want your signature to expire at the same time? (Y/n) -> yes\n";
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.replace_expired_okay/)
+ {
+ print $stdin "yes\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.dupe_okay/)
+ {
+ print $stdin "yes\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.sign_revoked\.okay/)
+ {
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.revoke_okay/)
+ {
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.expired_okay/)
+ {
+ print "The key has already expired!!!\n";
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.nosig_okay/)
+ {
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.v4_on_v3_okay/)
+ {
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.setpref\.okay/)
+ {
+ print $stdin "no\n";
+ }
+ elsif(m/^\[GNUPG:\] ALREADY_SIGNED/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] GOOD_PASSPHRASE/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] KEYEXPIRED/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] SIGEXPIRED/)
+ {
+ }
+ elsif(m/^\[GNUPG:\] NODATA/)
+ {
+ # To crash or not to crash, thats the question.
+ }
+ else
+ {
+ Error "ERROR: UNKNOWN $_\n";
+ }
+ }
+
+ while(<$stderr>)
+ {
+
+ SysLog "Received from GnuPG on stderr: $_\n";
+
+ if(m/^key ([0-9A-F]{8}): public key/)
+ {
+ #$keyid=$1;
+ }
+ }
+
+
+
+ waitpid($pid,0);
+
+ }
+
+#$do = `( $extras echo "365"; echo "y"; echo "2"; echo "y")|$gpgbin --no-tty --default-key gpg@cacert.org --homedir $homedir --batch --command-fd 0 --status-fd 1 --cert-policy-url http://www.cacert.org/index.php?id=10 --ask-cert-expire --sign-key $row[email] 2>&1`;
+
+ SysLog "Running GPG to export...\n";
+
+ my $do = `$gpgbin --no-tty --homedir $homedir --export --armor $keyid > $wid/result.key`;
+ SysLog $do;
+ $do = `$gpgbin --no-tty --homedir $homedir --batch --yes --delete-key $keyid 2>&1`;
+ SysLog $do;
+
+ if(open IN,"<$wid/result.key")
+ {
+ undef $/;
+ my $content=<IN>;
+ close IN;
+ $/="\n";
+
+ $content=~s/^.*-----BEGIN/-----BEGIN/s;
+ SysLog "Antworte...\n";
+ Response($ver,2,0,0,$content,"","");
+ SysLog "Done.\n";
+
+ if(!$debug)
+ {
+ unlink "$wid/request.key";
+ unlink "$wid/result.key";
+ }
+
+ }
+ else
+ {
+ SysLog "NO Resulting Key found!";
+ }
+ }
+ else
+ {
+ Error "Kann Request nicht speichern!\n";
+ }
+
+ unlink("$wid/secring.gpg");
+ unlink("$wid/pubring.gpg");
+ unlink("$wid");
+}
+
+sub RevokeX509
+{
+ my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
+
+ Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00"'\\]/);
+ Error "Invalid characters in Hash!\n" if(! $subject=~m/^[0-9a-fA-F]+$/);
+
+ SysLog "Widerrufe $PkiSystems{$_[0]}\n";
+ SysLog "Aktueller Hash vom Webserver: $subject\n";
+
+ my $iscurrent=0;
+
+ $currenthash{$root}=sha1_hex(readfile("revoke-root$root.crl"));
+
+ print "Aktueller Hash vom Signingserver: $currenthash{$root}\n";
+
+ if($subject eq $currenthash{$root})
+ {
+ print "Hash matches current CRL.\n";
+ print "Deleting old CRLs...\n";
+ foreach (<currentcrls/$root/*>)
+ {
+ if($_ ne "currentcrls/$root/$subject.crl")
+ {
+ print "Deleting $_\n";
+ unlink $_ ;
+ }
+ }
+ print "Done with deleting old CRLs.\n";
+ $iscurrent=1;
+ }
+
+ my $wid=CreateWorkspace();
+
+ my $opensslcnf=X509ConfigFile($root,$template);
+
+ if(open OUT,">$wid/request.crt")
+ {
+ print OUT $request;
+ close OUT;
+
+ my $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf -key test -batch -revoke $wid/request.crt > /dev/null 2>&1`;
+ $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf -key test -batch -gencrl -crldays 7 -crlexts crl_ext -out $wid/cacert-revoke.crl > /dev/null 2>&1`;
+ $do = `$opensslbin crl -inform PEM -in $wid/cacert-revoke.crl -outform DER -out $wid/revoke.crl > /dev/null 2>&1`;
+ unlink "$wid/cacert-revoke.crl";
+
+ if(open IN,"<$wid/revoke.crl")
+ {
+ undef $/;
+ my $content=<IN>;
+ close IN;
+ $/="\n";
+ unlink "$wid/revoke.crl";
+
+ mkdir "currentcrls/$root";
+ my $newcrlname="currentcrls/$root/".sha1_hex($content).".crl";
+ open OUT,">$newcrlname";
+ print OUT $content;
+ close OUT;
+
+ if($iscurrent)
+ {
+ SysLog "Schicke aktuelles Delta...\n";
+ system "xdelta delta revoke-root$root.crl $newcrlname delta$root.diff";
+ Response($ver,2,0,0,readfile("delta$root.diff"),"","");
+ #Response($ver,2,0,0,$content,"","");
+ }
+ else
+ {
+ if(-f "currentcrls/$root/$subject.crl")
+ {
+ SysLog "Schicke altes Delta...\n";
+ system "xdelta delta currentcrls/$root/$subject.crl $newcrlname delta$root.diff";
+
+ Response($ver,2,0,0,readfile("delta$root.diff"),"","");
+ #Response($ver,2,0,0,$content,"","");
+ }
+ else
+ {
+ SysLog "Out of Sync! Sending empty CRL...\n";
+ Response($ver,2,0,0,"","",""); # CRL !!!!!!!!!
+ }
+ }
+
+ open OUT,">revoke-root$root.crl";
+ print OUT $content;
+ close OUT;
+
+
+ SysLog "Done.\n";
+ }
+ }
+ unlink "$wid";
+}
+
+
+sub analyze($)
+{
+ SysLog "Analysiere ...\n";
+ #SysLog hexdump($_[0])."\n";
+
+ my @fields=unpack3array(substr($_[0],3,-9));
+ Error "Wrong number of parameters: ".scalar(@fields)."\n" if(scalar(@fields)!=4);
+
+ SysLog "Header: ".hexdump($fields[0])."\n";
+ my @bytes=unpack("C*",$fields[0]);
+
+ Error "Header too short!\n" if(length($fields[0])<3);
+
+ Error "Version mismatch. Server does not support version $bytes[0], server only supports version $ver!\n" if($bytes[0]!=$ver);
+
+ Error "Header has wrong length: ".length($fields[0])."!\n" if(length($fields[0])!=9);
+
+ if($bytes[1] == 0) # NUL Request
+ {
+ SysLog "NUL Request detected.\n";
+ if($fields[1])
+ {
+ open OUT,">timesync.sh";
+ print OUT "date -u $fields[1]\n";
+ print OUT "hwclock --systohc\n";
+ close OUT;
+ }
+ Response($ver,0,0,0,"","","");
+ }
+ elsif($bytes[1]==1) # Sign Request
+ {
+ SysLog "SignRequest detected...\n";
+ CheckSystem($bytes[2],$bytes[3],$bytes[4],$bytes[5]);
+ if($bytes[2]==1)
+ {
+ SignX509($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
+ }
+ elsif($bytes[2]==2)
+ {
+ SignOpenPGP($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
+ }
+ }
+ elsif($bytes[1]==2) # Revocation Request
+ {
+ SysLog "Revocation Request ...\n";
+ CheckSystem($bytes[2],$bytes[3],$bytes[4],$bytes[5]);
+ if($bytes[2]==1)
+ {
+ RevokeX509($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
+ }
+ }
+ else
+ {
+ Error "Unknown command\n";
+ }
+
+}
+
+SysLog "Server started. Waiting 5 minutes for contact from client ...\n";
+
+#When started, we wait for 5 minutes for the client to connect:
+my @ready=$sel->can_read($starttime);
+
+
+my $count=0;
+
+#As soon as the client connected successfully, the client has to send a request faster than every 10 seconds
+while(@ready = $sel->can_read(15) && -f "./server.pl-active")
+{
+ my $data="";
+ #my $length=read SER,$data,1;
+
+ #SysLog "Data: ".hexdump($data)."\n";
+
+ #Receive();
+
+ $data=Receive();
+ SysLog "Analysing ...\n";
+ analyze($data);
+
+# if($data eq "\x02")
+# {
+# #SysLog "Start empfangen, sende OK\n";
+# SendIt("\x10");
+#
+# my $block="";
+# my $blockfinished=0;
+# my $tries=10000;
+#
+# while(!$blockfinished)
+# {
+# Error "Tried reading too often\n" if(($tries--)<=0);
+#
+# $data="";
+# @ready = $sel->can_read(2);
+# $length=read SER,$data,100;
+# if($length)
+# {
+# $block.=$data;
+# }
+# $blockfinished=defined(unpack3(substr($block,0,-1)))?1:0;
+# }
+# #SysLog "Block done: ".hexdump($block)."\n";
+# if(CheckCRC($block))
+# {
+# SendIt("\x10");
+# analyze($block);
+# }
+# else
+# {
+# Error "CRC Error\n";
+# }
+# }
+# else
+# {
+# Error "Error: Wrong Startbyte!\n";
+# }
+
+ $count++;
+
+ SysLog "$count requests processed. Waiting on next request ...\n";
+
+}
+
+
+Error "Timeout! No data from client anymore!\n";
+