Merge branch 'bug-1394' into testserver-stable
[cacert-devel.git] / CommModule / server.pl
1 #!/usr/bin/perl -w
2
3 # (c) 2006-2007 by CAcert.org
4
5 # Server (running on the certificate machine)
6
7 use strict;
8 use Device::SerialPort qw( :PARAM :STAT 0.07 );
9 use POSIX;
10 use IO::Select;
11 use File::CounterFile;
12 use Time::HiRes q(usleep);
13 use IPC::Open3;
14 use File::Copy;
15 use Digest::SHA1 qw(sha1_hex);
16
17 #Protocol version:
18 my $ver=1;
19
20 my $debug=0;
21
22 my $paranoid=1;
23
24 my $serialport="/dev/ttyUSB0";
25 #my $serialport="/dev/ttyS0";
26
27 my $CPSUrl="http://www.cacert.org/cps.php";
28
29 my $OCSPUrl="http://ocsp.cacert.org/";
30
31 my $gpgbin="/usr/bin/gpg";
32
33 my $opensslbin="/usr/bin/openssl";
34
35 my $work="./work";
36
37 #my $gpgID='gpgtest@cacert.at';
38 my $gpgID='gpg@cacert.org';
39
40
41 my %PkiSystems=(
42 "1"=>"X.509",
43 "2"=>"OpenPGP");
44 my %rootkeys=(
45 "1"=>5, #X.509
46 "2"=>1);#OpenPGP
47 my %hashes=(
48 "0"=>"",
49 "1"=>"-md md5",
50 "2"=>"-md sha1",
51 "3"=>"-md rmd160",
52 "8"=>"-md sha256",
53 "9"=>"-md sha384",
54 "10"=>"-md sha512");
55 my %templates=(
56 "0"=>"client.cnf",
57 "1"=>"client-org.cnf",
58 "2"=>"client-codesign.cnf",
59 "3"=>"client-machine.cnf",
60 "4"=>"client-ads.cnf",
61 "5"=>"server.cnf",
62 "6"=>"server-org.cnf",
63 "7"=>"server-jabber.cnf",
64 "8"=>"ocsp.cnf",
65 "9"=>"timestamp.cnf",
66 "10"=>"proxy.cnf",
67 "11"=>"subca.cnf"
68 );
69
70 my $starttime=5*60; # 5 minutes
71
72 my %currenthash=();
73
74
75 #End of configurations
76
77 ########################################################
78
79 mkdir "$work",0700;
80 mkdir "currentcrls";
81
82 $ENV{'PATH'}='/usr/bin/:/bin';
83 $ENV{'IFS'}="\n";
84 $ENV{'LD_PRELOAD'}='';
85 $ENV{'LD_LIBRARY_PATH'}='';
86 $ENV{'LANG'}='';
87
88 #Logging functions:
89 sub SysLog($)
90 {
91 my $date=strftime("%Y-%m-%d",localtime);
92 open LOG,">>logfile$date.txt";
93 return if(not defined($_[0]));
94 my $timestamp=strftime("%Y-%m-%d %H:%M:%S",localtime);
95 #$syslog->write($_[0]."\x00");
96 print LOG "$timestamp $_[0]";
97 # print "$timestamp $_[0]";
98 flush LOG;
99 close LOG;
100 }
101
102 sub Error($)
103 {
104 SysLog($_[0]);
105 if($paranoid)
106 {
107 die $_[0];
108 }
109 }
110
111 sub readfile($)
112 {
113 my $olds=$/;
114 open READIN,"<$_[0]";
115 undef $/;
116 my $content=<READIN>;
117 close READIN;
118 $/=$olds;
119 return $content;
120 }
121
122
123 #Hexdump function: Returns the hexdump representation of a string
124 sub hexdump($)
125 {
126 return "" if(not defined($_[0]));
127 my $content="";
128 $content.=sprintf("%02X ",unpack("C",substr($_[0],$_,1))) foreach (0 .. length($_[0])-1);
129 return $content;
130 }
131
132 #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
133 sub pack3
134 {
135 return "\x00\x00\x00" if(!defined($_[0]));
136 my $data=(length($_[0]) >= 2**24)? "":$_[0];
137 my $len=pack("N",length($data));
138 #print "len: ".length($data)."\n";
139 return substr($len,1,3).$data;
140 }
141
142
143 #unpack3 unpacks packed data.
144 sub unpack3($)
145 {
146 return undef if((not defined($_[0])) or length($_[0])<3);
147 #print "hexdump: ".hexdump("\x00".substr($_[0],0,3))."\n";
148 my $len=unpack("N","\x00".substr($_[0],0,3));
149 #print "len3: $len length(): ".length($_[0])." length()-3: ".(length($_[0])-3)."\n";
150 return undef if(length($_[0])-3 != $len);
151 return substr($_[0],3);
152 }
153
154
155 #unpack3array extracts a whole array of concatented packed data.
156 sub unpack3array($)
157 {
158 my @retarr=();
159 if((not defined($_[0])) or length($_[0])<3)
160 {
161 SysLog "Datenanfang kaputt\n";
162 return ();
163 }
164 my $dataleft=$_[0];
165 while(length($dataleft)>=3)
166 {
167 #print "hexdump: ".hexdump("\x00".substr($dataleft,0,3))."\n";
168 my $len=unpack("N","\x00".substr($dataleft,0,3));
169 #print "len3: $len length(): ".length($dataleft)." length()-3: ".(length($dataleft)-3)."\n";
170 if(length($dataleft)-3 < $len)
171 {
172 SysLog "Datensatz abgeschnitten\n";
173 return ();
174 }
175 push @retarr, substr($dataleft,3,$len);
176 $dataleft=substr($dataleft,3+$len);
177 }
178 if(length($dataleft)!=0)
179 {
180 SysLog "Ende abgeschnitten\n";
181 return ();
182 }
183 return @retarr;
184 }
185
186
187
188
189 my $timestamp=strftime("%Y-%m-%d %H:%M:%S",localtime);
190
191 SysLog("Starting Server at $timestamp\n");
192
193 SysLog("Opening Serial interface:\n");
194 #if(1)
195 #{
196
197 sub SerialSettings
198 {
199 my $PortObj=$_[0];
200 Error "Could not open Serial Port!\n" if(!defined($PortObj));
201 $PortObj->baudrate(115200);
202 $PortObj->parity("none");
203 $PortObj->databits(8);
204 $PortObj->stopbits(1);
205 }
206
207 #We have to open the SerialPort and close it again, so that we can bind it to a Handle
208 my $PortObj = new Device::SerialPort($serialport);
209 SerialSettings($PortObj);
210 $PortObj->save("serialserver.conf");
211 #}
212 undef $PortObj;
213
214 $PortObj = tie (*SER, 'Device::SerialPort', "serialserver.conf") || Error "Can't tie using Configuration_File_Name: $!\n";
215
216 Error "Could not open Serial Interface!\n" if(not defined($PortObj));
217 SerialSettings($PortObj);
218 #open SER,">$serialport";
219
220 SysLog("Serial interface opened: $PortObj\n");
221
222
223 #Creating select() selector for improved reading:
224 my $sel = new IO::Select( \*SER );
225
226 #Raw send function over the Serial Interface (+debugging)
227 sub SendIt($)
228 {
229 return unless defined($_[0]);
230 SysLog "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n";
231 my $data=$_[0];
232 my $runcount=0;
233 my $total=0;
234 my $mtu=30;
235 while(length($data))
236 {
237 my $iwrote=scalar($PortObj->write(substr($data,0,$mtu)))||0;
238 usleep(270*$iwrote+9000); # On Linux, we have to wait to make sure it is being sent, and we dont loose any data.
239 $total+=$iwrote;
240 $data=substr($data,$iwrote);
241 print "i wrote: $iwrote total: $total left: ".length($data)."\n" if(!($runcount++ %10));
242 }
243
244 # print "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n";
245 # foreach(0 .. length($_[0]))
246 # {
247 # $PortObj->write(substr($_[0],$_,1));
248 # }
249
250 }
251
252
253 #Send data over the Serial Interface with handshaking:
254 #Warning: This function is implemented paranoid. It exits the program in case something goes wrong.
255 sub SendHandshakedParanoid($)
256 {
257 #print "Shaking hands ...\n";
258 SendIt("\x02");
259
260 Error "Handshake uncompleted. Connection lost!" if(!scalar($sel->can_read(2)));
261 my $data="";
262 usleep(1000000);
263 my $length=read SER,$data,1;
264 if($length && $data eq "\x10")
265 {
266 print "OK ...\n";
267 my $xor=0;
268 foreach(0 .. length($_[0])-1)
269 {
270 #print "xor mit ".unpack("C",substr($_[0],$_,1))."\n";
271 $xor ^= unpack("C",substr($_[0],$_,1));
272 }
273 #print "XOR: $xor\n";
274
275 my $tryagain=1;
276 while($tryagain)
277 {
278 SendIt($_[0].pack("C",$xor)."rie4Ech7");
279
280 Error "Packet receipt was not confirmed in 5 seconds. Connection lost!" if(!scalar($sel->can_read(5)));
281
282 $data="";
283 $length=read SER,$data,1;
284
285 if($length && $data eq "\x10")
286 {
287 SysLog "Sent successfully!...\n";
288 $tryagain=0;
289 }
290 elsif($length && $data eq "\x11")
291 {
292 $tryagain=1;
293 }
294 else
295 {
296 Error "I cannot send! $length ".unpack("C",$data)."\n";
297 }
298 }
299
300 }
301 else
302 {
303 print "!Cannot send! $length $data\n";
304 Error "!Stopped sending.\n";
305 }
306 }
307
308 sub Receive
309 {
310 my $data="";
311 my @ready = $sel->can_read(20);
312
313 my $length=read SER,$data,1,0;
314
315 #SysLog "Data: ".hexdump($data)."\n";
316
317 if($data eq "\x02")
318 {
319 my $modus=1;
320 SysLog "Start received, sending OK\n";
321 SendIt("\x10");
322
323 my $block="";
324 my $blockfinished=0;
325 my $tries=10000;
326
327 while(!$blockfinished)
328 {
329 Error("Tried reading too often\n") if(($tries--)<=0);
330
331 $data="";
332 if(!scalar($sel->can_read(2)))
333 {
334 SysLog("Timeout!\n");
335 return;
336 }
337 $length=read SER,$data,100,0;
338 if($length)
339 {
340 $block.=$data;
341 }
342 #SysLog("Received: $length ".length($block)."\n");
343 $blockfinished=defined(unpack3(substr($block,0,-9)))?1:0;
344
345 if(!$blockfinished and substr($block,-8,8) eq "rie4Ech7")
346 {
347 SysLog "BROKEN Block detected!";
348 SendIt("\x11");
349 $block="";
350 $blockfinished=0;
351 $tries=10000;
352 }
353
354 }
355 SysLog "Block done: \n";#.hexdump($block)."\n";
356 SendIt("\x10");
357 SysLog "Returning block\n";
358 return($block);
359 }
360 else
361 {
362 Error("Error: No Answer received, Timeout.\n") if(length($data)==0);
363 Error("Error: Wrong Startbyte: ".hexdump($data)." !\n");
364 }
365
366 SysLog "Waiting on next request ...\n";
367
368 }
369
370
371 #Checks the CRC of a received block for validity
372 #Returns 1 upon successful check and 0 for a failure
373 sub CheckCRC($)
374 {
375 my $block=$_[0];
376 return 0 if(length($_[0])<1);
377 return 1 if($_[0] eq "\x00");
378 my $xor=0;
379 foreach(0 .. length($block)-2)
380 {
381 #print "xor mit ".unpack("C",substr($block,$_,1))."\n";
382 $xor ^= unpack("C",substr($block,$_,1));
383 }
384 #print "XOR: $xor BCC: ".unpack("C",substr($block,-1,1))."\n";
385 if($xor eq unpack("C",substr($block,-1,1)))
386 {
387 #print "Checksum correct\n";
388 return 1;
389 }
390 else
391 {
392 #print "Checksum on received packet wrong!\n";
393 return 0;
394 }
395
396 }
397
398 #Formatting and sending a Response packet
399 sub Response($$$$$$$)
400 {
401 SendHandshakedParanoid(pack3(pack3(pack("C*",$_[0],$_[1],$_[2],$_[3])).pack3($_[4]).pack3($_[5]).pack3($_[6])));
402 }
403
404
405 #Checks the parameters, whether the certificate system (OpenPGP, X.509, ...) is available,
406 #whether the specified root key is available, whether the config file is available, ...
407 #Returns 1 upon success, and dies upon error!
408 sub CheckSystem($$$$)
409 {
410 my ($system,$root,$template,$hash)=@_;
411 if(not defined($templates{$template}))
412 {
413 Error "Template unknown!\n";
414 }
415 if(not defined($hashes{$hash}))
416 {
417 Error "Hash algorithm unknown!\n";
418 }
419 if(defined($rootkeys{$system}))
420 {
421 if($root<$rootkeys{$system})
422 {
423 return 1;
424 }
425 else
426 {
427 Error "Identity System $system has only $rootkeys{$system} root keys, key $root does not exist.\n";
428 }
429 }
430 else
431 {
432 Error "Identity System $system not supported";
433 }
434
435 return 0;
436 }
437
438
439 #Selects the specified config file for OpenSSL and makes sure that the specified config file exists
440 #Returns the full path to the config file
441 sub X509ConfigFile($$)
442 {
443 my ($root,$template)=@_;
444 my $opensslcnf="";
445 if($root==0)
446 {
447 $opensslcnf="/etc/ssl/openssl-$templates{$template}";
448 }
449 elsif($root==1)
450 {
451 $opensslcnf="/etc/ssl/class3-$templates{$template}";
452 }
453 elsif($root==2)
454 {
455 $opensslcnf="/etc/ssl/class3s-$templates{$template}";
456 }
457 else
458 {
459 $opensslcnf="/etc/ssl/root$root/$templates{$template}";
460 }
461 # Check that the config file exists
462 Error "Config file does not exist: $opensslcnf!" unless (-f $opensslcnf);
463
464 return $opensslcnf;
465 }
466
467 sub CreateWorkspace()
468 {
469 mkdir "$work",0700;
470 my $id = (new File::CounterFile "./$work/.counter", "0")->inc;
471 mkdir "$work/".int($id/1000),0700;
472 mkdir "$work/".int($id/1000)."/".($id%1000),0700;
473 my $wid="$work/".int($id/1000)."/".($id%1000);
474 SysLog "Creating Working directory: $wid\n";
475 return $wid;
476 }
477
478
479 sub SignX509($$$$$$$$)
480 {
481 my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
482
483 my $wid=CreateWorkspace();
484
485 my $opensslcnf=X509ConfigFile($root,$template);
486
487 print "Subject: $subject\n";
488 print "SAN: $san\n";
489
490
491 $subject=~ s/\\x([A-F0-9]{2})/pack("C", hex($1))/egi;
492 $san=~ s/\\x([A-F0-9]{2})/pack("C", hex($1))/egi;
493
494 Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00#"'\\]/);
495 Error "Invalid characters in Subject: ".hexdump($subject)." - $subject\n" if($subject=~m/[\n\r\t\x00#"'\\]/);
496
497 print "Subject: $subject\n";
498 print "SAN: $san\n";
499
500 my $extfile="";
501 if($templates{$template}=~m/server/) #??? Should we really do that for all and only for server certs?
502 {
503 open OUT,">$wid/extfile";
504 print OUT "basicConstraints = critical, CA:FALSE\n";
505 print OUT "keyUsage = critical, digitalSignature, keyEncipherment, keyAgreement\n";
506 print OUT "extendedKeyUsage = clientAuth, serverAuth, nsSGC, msSGC\n";
507 print OUT "authorityInfoAccess = OCSP;URI:$OCSPUrl\n";
508
509 my $CRLUrl="";
510 if($root==0)
511 {
512 $CRLUrl="http://crl.cacert.org/revoke.crl";
513 }
514 elsif($root==1)
515 {
516 $CRLUrl="http://crl.cacert.org/class3-revoke.crl";
517 }
518 elsif($root==2)
519 {
520 $CRLUrl="http://crl.cacert.org/class3s-revoke.crl";
521 }
522 else
523 {
524 $CRLUrl="http://crl.cacert.org/root${root}.crl";
525 }
526 print OUT "crlDistributionPoints = URI:${CRLUrl}\n";
527 print OUT "subjectAltName = $san\n" if(length($san));
528 close OUT;
529 $extfile=" -extfile $wid/extfile ";
530 }
531
532 my $cmd=($request=~m/SPKAC\s*=/)?"-spkac":"-subj '$subject' -in";
533
534 #my $cmd=$spkac?"-spkac":"-subj '$subject' -in";
535
536
537 if(open OUT,">$wid/request.csr")
538 {
539 print OUT $request;
540 close OUT;
541
542 my $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf $cmd $wid/request.csr -out $wid/output.crt -days $days -key test -batch $extfile 2>&1`;
543
544 SysLog $do;
545
546
547 if(open IN,"<$wid/output.crt")
548 {
549 undef $/;
550 my $content=<IN>;
551 close IN;
552 $/="\n";
553
554 $content=~s/^.*-----BEGIN/-----BEGIN/s;
555 SysLog "Antworte...\n";
556 Response($ver,1,0,0,$content,"","");
557 SysLog "Done.\n";
558 if(!$debug)
559 {
560 unlink "$wid/output.crt";
561 unlink "$wid/request.csr";
562 unlink "$wid/extfile";
563 }
564 }
565 else
566 {
567 Error("Could not read the resulting certificate.\n");
568 }
569 }
570 else
571 {
572 Error("Could not save request.\n");
573 }
574 unlink "$wid";
575 }
576
577 sub SignOpenPGP
578 {
579 my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
580
581 my $wid=CreateWorkspace();
582
583 if(! -f "secring$root.gpg")
584 {
585 Error "Root Key not found: secring$root.gpg !\n";
586 }
587
588 copy("secring$root.gpg","$wid/secring.gpg");
589 copy("pubring$root.gpg","$wid/pubring.gpg");
590
591 my $keyid=undef;
592
593 Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00#"'\\]/);
594 Error "Invalid characters in Subject!\n" if($subject=~m/[ \n\r\t\x00#"'\\;]/);
595
596
597 if(open OUT,">$wid/request.key")
598 {
599 print OUT $request;
600 close OUT;
601
602
603 #!!!! ?!?
604 #my $homedir=-w "/root/.gnupg" ? "/root/.gnupg":"$wid/";
605 my $homedir="$wid/";
606
607 {
608 SysLog "Running GnuPG in $homedir...\n";
609 my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
610
611
612 SysLog "Importiere $gpgbin --no-tty --homedir $homedir --import $wid/request.key\n";
613
614 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");
615
616 if (!$pid) {
617 Error "Cannot fork GnuPG.";
618 }
619 $/="\n";
620 while(<$stdout>)
621 {
622 SysLog "Received from GnuPG: $_\n";
623 if(m/^\[GNUPG:\] GOT_IT/)
624 {
625 }
626 elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.setpref\.okay/)
627 {
628 print $stdin "no\n";
629 }
630 elsif(m/^\[GNUPG:\] ALREADY_SIGNED/)
631 {
632 }
633 elsif(m/^\[GNUPG:\] GOOD_PASSPHRASE/)
634 {
635 }
636 elsif(m/^\[GNUPG:\] KEYEXPIRED/)
637 {
638 }
639 elsif(m/^\[GNUPG:\] SIGEXPIRED/)
640 {
641 }
642 elsif(m/^\[GNUPG:\] IMPORT_OK/)
643 {
644 }
645 elsif(m/^\[GNUPG:\] IMPORT_RES/)
646 {
647 }
648 elsif(m/^\[GNUPG:\] IMPORTED ([0-9A-F]{16})/)
649 {
650 Error "More than one OpenPGP sent at once!" if(defined($keyid));
651 $keyid=$1;
652 }
653 elsif(m/^\[GNUPG:\] NODATA/)
654 {
655 # To crash or not to crash, thats the question.
656 }
657 else
658 {
659 Error "ERROR: UNKNOWN $_\n";
660 }
661
662 }
663
664 while(<$stderr>)
665 {
666
667 SysLog "Received from GnuPG on stderr: $_\n";
668
669 if(m/^key ([0-9A-F]{8}): public key/)
670 {
671 #$keyid=$1;
672 }
673 }
674
675 waitpid($pid,0);
676
677 }
678
679 Error "No KeyID found!" if(!defined($keyid));
680
681
682 SysLog "Running GnuPG to Sign...\n";
683
684 {
685 my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
686
687
688
689 $ENV{'LANG'}="";
690
691 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 ";
692 SysLog($line."\n");
693
694 my $pid = open3($stdin,$stdout,$stderr,$line);
695
696 if (!$pid) {
697 Error "Cannot fork GnuPG.";
698 }
699 SysLog "Got PID $pid\n";
700 while(<$stdout>)
701 {
702 SysLog "Received from GnuPG: $_\n";
703 if(m/^\[GNUPG:\] GET_BOOL keyedit\.sign_all\.okay/)
704 {
705 print $stdin "yes\n";
706 }
707 elsif(m/^\[GNUPG:\] GOT_IT/)
708 {
709 }
710 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.okay/)
711 {
712 print $stdin "yes\n";
713 }
714 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.expire_okay/)
715 {
716 print $stdin "yes\n";
717 }
718 elsif(m/^\[GNUPG:\] GET_LINE siggen\.valid\s?$/)
719 {
720 print $stdin "$days\n";
721 }
722 elsif(m/^\[GNUPG:\] GET_LINE sign_uid\.expire\s?$/)
723 {
724 print "DETECTED: Do you want your signature to expire at the same time? (Y/n) -> yes\n";
725 print $stdin "no\n";
726 }
727 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.replace_expired_okay/)
728 {
729 print $stdin "yes\n";
730 }
731 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.dupe_okay/)
732 {
733 print $stdin "yes\n";
734 }
735 elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.sign_revoked\.okay/)
736 {
737 print $stdin "no\n";
738 }
739 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.revoke_okay/)
740 {
741 print $stdin "no\n";
742 }
743 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.expired_okay/)
744 {
745 print "The key has already expired!!!\n";
746 print $stdin "no\n";
747 }
748 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.nosig_okay/)
749 {
750 print $stdin "no\n";
751 }
752 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.v4_on_v3_okay/)
753 {
754 print $stdin "no\n";
755 }
756 elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.setpref\.okay/)
757 {
758 print $stdin "no\n";
759 }
760 elsif(m/^\[GNUPG:\] ALREADY_SIGNED/)
761 {
762 }
763 elsif(m/^\[GNUPG:\] GOOD_PASSPHRASE/)
764 {
765 }
766 elsif(m/^\[GNUPG:\] KEYEXPIRED/)
767 {
768 }
769 elsif(m/^\[GNUPG:\] SIGEXPIRED/)
770 {
771 }
772 elsif(m/^\[GNUPG:\] NODATA/)
773 {
774 # To crash or not to crash, thats the question.
775 }
776 else
777 {
778 Error "ERROR: UNKNOWN $_\n";
779 }
780 }
781
782 while(<$stderr>)
783 {
784
785 SysLog "Received from GnuPG on stderr: $_\n";
786
787 if(m/^key ([0-9A-F]{8}): public key/)
788 {
789 #$keyid=$1;
790 }
791 }
792
793
794
795 waitpid($pid,0);
796
797 }
798
799 #$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`;
800
801 SysLog "Running GPG to export...\n";
802
803 my $do = `$gpgbin --no-tty --homedir $homedir --export --armor $keyid > $wid/result.key`;
804 SysLog $do;
805 $do = `$gpgbin --no-tty --homedir $homedir --batch --yes --delete-key $keyid 2>&1`;
806 SysLog $do;
807
808 if(open IN,"<$wid/result.key")
809 {
810 undef $/;
811 my $content=<IN>;
812 close IN;
813 $/="\n";
814
815 $content=~s/^.*-----BEGIN/-----BEGIN/s;
816 SysLog "Antworte...\n";
817 Response($ver,2,0,0,$content,"","");
818 SysLog "Done.\n";
819
820 if(!$debug)
821 {
822 unlink "$wid/request.key";
823 unlink "$wid/result.key";
824 }
825
826 }
827 else
828 {
829 SysLog "NO Resulting Key found!";
830 }
831 }
832 else
833 {
834 Error "Kann Request nicht speichern!\n";
835 }
836
837 unlink("$wid/secring.gpg");
838 unlink("$wid/pubring.gpg");
839 unlink("$wid");
840 }
841
842 sub RevokeX509
843 {
844 my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
845
846 Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00#"'\\]/);
847 Error "Invalid characters in Hash!\n" if(! $subject=~m/^[0-9a-fA-F]+$/);
848
849 SysLog "Widerrufe $PkiSystems{$_[0]}\n";
850 SysLog "Aktueller Hash vom Webserver: $subject\n";
851
852 my $iscurrent=0;
853
854 $currenthash{$root}=sha1_hex(readfile("revoke-root$root.crl"));
855
856 print "Aktueller Hash vom Signingserver: $currenthash{$root}\n";
857
858 if($subject eq $currenthash{$root})
859 {
860 print "Hash matches current CRL.\n";
861 print "Deleting old CRLs...\n";
862 foreach (<currentcrls/$root/*>)
863 {
864 if($_ ne "currentcrls/$root/$subject.crl")
865 {
866 print "Deleting $_\n";
867 unlink $_ ;
868 }
869 }
870 print "Done with deleting old CRLs.\n";
871 $iscurrent=1;
872 }
873
874 my $wid=CreateWorkspace();
875
876 my $opensslcnf=X509ConfigFile($root,$template);
877
878 if(open OUT,">$wid/request.crt")
879 {
880 print OUT $request;
881 close OUT;
882
883 my $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf -key test -batch -revoke $wid/request.crt > /dev/null 2>&1`;
884 $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`;
885 $do = `$opensslbin crl -inform PEM -in $wid/cacert-revoke.crl -outform DER -out $wid/revoke.crl > /dev/null 2>&1`;
886 unlink "$wid/cacert-revoke.crl";
887
888 if(open IN,"<$wid/revoke.crl")
889 {
890 undef $/;
891 my $content=<IN>;
892 close IN;
893 $/="\n";
894 unlink "$wid/revoke.crl";
895
896 mkdir "currentcrls/$root";
897 my $newcrlname="currentcrls/$root/".sha1_hex($content).".crl";
898 open OUT,">$newcrlname";
899 print OUT $content;
900 close OUT;
901
902 if($iscurrent)
903 {
904 SysLog "Schicke aktuelles Delta...\n";
905 system "xdelta delta revoke-root$root.crl $newcrlname delta$root.diff";
906 Response($ver,2,0,0,readfile("delta$root.diff"),"","");
907 #Response($ver,2,0,0,$content,"","");
908 }
909 else
910 {
911 if(-f "currentcrls/$root/$subject.crl")
912 {
913 SysLog "Schicke altes Delta...\n";
914 system "xdelta delta currentcrls/$root/$subject.crl $newcrlname delta$root.diff";
915
916 Response($ver,2,0,0,readfile("delta$root.diff"),"","");
917 #Response($ver,2,0,0,$content,"","");
918 }
919 else
920 {
921 SysLog "Out of Sync! Sending empty CRL...\n";
922 Response($ver,2,0,0,"","",""); # CRL !!!!!!!!!
923 }
924 }
925
926 open OUT,">revoke-root$root.crl";
927 print OUT $content;
928 close OUT;
929
930
931 SysLog "Done.\n";
932 }
933 }
934 unlink "$wid";
935 }
936
937
938 sub analyze($)
939 {
940 SysLog "Analysiere ...\n";
941 #SysLog hexdump($_[0])."\n";
942
943 my @fields=unpack3array(substr($_[0],3,-9));
944 Error "Wrong number of parameters: ".scalar(@fields)."\n" if(scalar(@fields)!=4);
945
946 SysLog "Header: ".hexdump($fields[0])."\n";
947 my @bytes=unpack("C*",$fields[0]);
948
949 Error "Header too short!\n" if(length($fields[0])<3);
950
951 Error "Version mismatch. Server does not support version $bytes[0], server only supports version $ver!\n" if($bytes[0]!=$ver);
952
953 Error "Header has wrong length: ".length($fields[0])."!\n" if(length($fields[0])!=9);
954
955 if($bytes[1] == 0) # NUL Request
956 {
957 SysLog "NUL Request detected.\n";
958 if($fields[1] =~ /^\d+\.\d+$/)
959 {
960 open OUT,">timesync.sh";
961 print OUT "date -u '$fields[1]'\n";
962 print OUT "hwclock --systohc\n";
963 close OUT;
964 }
965 Response($ver,0,0,0,"","","");
966 }
967 elsif($bytes[1]==1) # Sign Request
968 {
969 SysLog "SignRequest detected...\n";
970 CheckSystem($bytes[2],$bytes[3],$bytes[4],$bytes[5]);
971 if($bytes[2]==1)
972 {
973 SignX509($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
974 }
975 elsif($bytes[2]==2)
976 {
977 SignOpenPGP($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
978 }
979 }
980 elsif($bytes[1]==2) # Revocation Request
981 {
982 SysLog "Revocation Request ...\n";
983 CheckSystem($bytes[2],$bytes[3],$bytes[4],$bytes[5]);
984 if($bytes[2]==1)
985 {
986 RevokeX509($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
987 }
988 }
989 else
990 {
991 Error "Unknown command\n";
992 }
993
994 }
995
996 SysLog "Server started. Waiting 5 minutes for contact from client ...\n";
997
998 #When started, we wait for 5 minutes for the client to connect:
999 my @ready=$sel->can_read($starttime);
1000
1001
1002 my $count=0;
1003
1004 #As soon as the client connected successfully, the client has to send a request faster than every 10 seconds
1005 while((@ready = $sel->can_read(15)) && -f "./server.pl-active")
1006 {
1007 my $data="";
1008 #my $length=read SER,$data,1;
1009
1010 #SysLog "Data: ".hexdump($data)."\n";
1011
1012 #Receive();
1013
1014 $data=Receive();
1015 SysLog "Analysing ...\n";
1016 analyze($data);
1017
1018 # if($data eq "\x02")
1019 # {
1020 # #SysLog "Start empfangen, sende OK\n";
1021 # SendIt("\x10");
1022 #
1023 # my $block="";
1024 # my $blockfinished=0;
1025 # my $tries=10000;
1026 #
1027 # while(!$blockfinished)
1028 # {
1029 # Error "Tried reading too often\n" if(($tries--)<=0);
1030 #
1031 # $data="";
1032 # @ready = $sel->can_read(2);
1033 # $length=read SER,$data,100;
1034 # if($length)
1035 # {
1036 # $block.=$data;
1037 # }
1038 # $blockfinished=defined(unpack3(substr($block,0,-1)))?1:0;
1039 # }
1040 # #SysLog "Block done: ".hexdump($block)."\n";
1041 # if(CheckCRC($block))
1042 # {
1043 # SendIt("\x10");
1044 # analyze($block);
1045 # }
1046 # else
1047 # {
1048 # Error "CRC Error\n";
1049 # }
1050 # }
1051 # else
1052 # {
1053 # Error "Error: Wrong Startbyte!\n";
1054 # }
1055
1056 $count++;
1057
1058 SysLog "$count requests processed. Waiting on next request ...\n";
1059
1060 }
1061
1062
1063 Error "Timeout! No data from client anymore!\n";
1064