Merge branch 'bug-896' into release
[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 "extendedKeyUsage = clientAuth, serverAuth, nsSGC, msSGC\n";
506 print OUT "keyUsage = digitalSignature, keyEncipherment\n";
507 print OUT "authorityInfoAccess = OCSP;URI:$OCSPUrl\n";
508 print OUT "subjectAltName = $san\n" if(length($san));
509 close OUT;
510 $extfile=" -extfile $wid/extfile ";
511 }
512
513 my $cmd=($request=~m/SPKAC\s*=/)?"-spkac":"-subj '$subject' -in";
514
515 #my $cmd=$spkac?"-spkac":"-subj '$subject' -in";
516
517
518 if(open OUT,">$wid/request.csr")
519 {
520 print OUT $request;
521 close OUT;
522
523 my $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf $cmd $wid/request.csr -out $wid/output.crt -days $days -key test -batch $extfile 2>&1`;
524
525 SysLog $do;
526
527
528 if(open IN,"<$wid/output.crt")
529 {
530 undef $/;
531 my $content=<IN>;
532 close IN;
533 $/="\n";
534
535 $content=~s/^.*-----BEGIN/-----BEGIN/s;
536 SysLog "Antworte...\n";
537 Response($ver,1,0,0,$content,"","");
538 SysLog "Done.\n";
539 if(!$debug)
540 {
541 unlink "$wid/output.crt";
542 unlink "$wid/request.csr";
543 unlink "$wid/extfile";
544 }
545 }
546 else
547 {
548 Error("Could not read the resulting certificate.\n");
549 }
550 }
551 else
552 {
553 Error("Could not save request.\n");
554 }
555 unlink "$wid";
556 }
557
558 sub SignOpenPGP
559 {
560 my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
561
562 my $wid=CreateWorkspace();
563
564 if(! -f "secring$root.gpg")
565 {
566 Error "Root Key not found: secring$root.gpg !\n";
567 }
568
569 copy("secring$root.gpg","$wid/secring.gpg");
570 copy("pubring$root.gpg","$wid/pubring.gpg");
571
572 my $keyid=undef;
573
574 Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00"'\\]/);
575 Error "Invalid characters in Subject!\n" if($subject=~m/[ \n\r\t\x00"'\\;]/);
576
577
578 if(open OUT,">$wid/request.key")
579 {
580 print OUT $request;
581 close OUT;
582
583
584 #!!!! ?!?
585 #my $homedir=-w "/root/.gnupg" ? "/root/.gnupg":"$wid/";
586 my $homedir="$wid/";
587
588 {
589 SysLog "Running GnuPG in $homedir...\n";
590 my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
591
592
593 SysLog "Importiere $gpgbin --no-tty --homedir $homedir --import $wid/request.key\n";
594
595 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");
596
597 if (!$pid) {
598 Error "Cannot fork GnuPG.";
599 }
600 $/="\n";
601 while(<$stdout>)
602 {
603 SysLog "Received from GnuPG: $_\n";
604 if(m/^\[GNUPG:\] GOT_IT/)
605 {
606 }
607 elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.setpref\.okay/)
608 {
609 print $stdin "no\n";
610 }
611 elsif(m/^\[GNUPG:\] ALREADY_SIGNED/)
612 {
613 }
614 elsif(m/^\[GNUPG:\] GOOD_PASSPHRASE/)
615 {
616 }
617 elsif(m/^\[GNUPG:\] KEYEXPIRED/)
618 {
619 }
620 elsif(m/^\[GNUPG:\] SIGEXPIRED/)
621 {
622 }
623 elsif(m/^\[GNUPG:\] IMPORT_OK/)
624 {
625 }
626 elsif(m/^\[GNUPG:\] IMPORT_RES/)
627 {
628 }
629 elsif(m/^\[GNUPG:\] IMPORTED ([0-9A-F]{16})/)
630 {
631 Error "More than one OpenPGP sent at once!" if(defined($keyid));
632 $keyid=$1;
633 }
634 elsif(m/^\[GNUPG:\] NODATA/)
635 {
636 # To crash or not to crash, thats the question.
637 }
638 else
639 {
640 Error "ERROR: UNKNOWN $_\n";
641 }
642
643 }
644
645 while(<$stderr>)
646 {
647
648 SysLog "Received from GnuPG on stderr: $_\n";
649
650 if(m/^key ([0-9A-F]{8}): public key/)
651 {
652 #$keyid=$1;
653 }
654 }
655
656 waitpid($pid,0);
657
658 }
659
660 Error "No KeyID found!" if(!defined($keyid));
661
662
663 SysLog "Running GnuPG to Sign...\n";
664
665 {
666 my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
667
668
669
670 $ENV{'LANG'}="";
671
672 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 ";
673 SysLog($line."\n");
674
675 my $pid = open3($stdin,$stdout,$stderr,$line);
676
677 if (!$pid) {
678 Error "Cannot fork GnuPG.";
679 }
680 SysLog "Got PID $pid\n";
681 while(<$stdout>)
682 {
683 SysLog "Received from GnuPG: $_\n";
684 if(m/^\[GNUPG:\] GET_BOOL keyedit\.sign_all\.okay/)
685 {
686 print $stdin "yes\n";
687 }
688 elsif(m/^\[GNUPG:\] GOT_IT/)
689 {
690 }
691 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.okay/)
692 {
693 print $stdin "yes\n";
694 }
695 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.expire_okay/)
696 {
697 print $stdin "yes\n";
698 }
699 elsif(m/^\[GNUPG:\] GET_LINE siggen\.valid\s?$/)
700 {
701 print $stdin "$days\n";
702 }
703 elsif(m/^\[GNUPG:\] GET_LINE sign_uid\.expire\s?$/)
704 {
705 print "DETECTED: Do you want your signature to expire at the same time? (Y/n) -> yes\n";
706 print $stdin "no\n";
707 }
708 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.replace_expired_okay/)
709 {
710 print $stdin "yes\n";
711 }
712 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.dupe_okay/)
713 {
714 print $stdin "yes\n";
715 }
716 elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.sign_revoked\.okay/)
717 {
718 print $stdin "no\n";
719 }
720 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.revoke_okay/)
721 {
722 print $stdin "no\n";
723 }
724 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.expired_okay/)
725 {
726 print "The key has already expired!!!\n";
727 print $stdin "no\n";
728 }
729 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.nosig_okay/)
730 {
731 print $stdin "no\n";
732 }
733 elsif(m/^\[GNUPG:\] GET_BOOL sign_uid\.v4_on_v3_okay/)
734 {
735 print $stdin "no\n";
736 }
737 elsif(m/^\[GNUPG:\] GET_BOOL keyedit\.setpref\.okay/)
738 {
739 print $stdin "no\n";
740 }
741 elsif(m/^\[GNUPG:\] ALREADY_SIGNED/)
742 {
743 }
744 elsif(m/^\[GNUPG:\] GOOD_PASSPHRASE/)
745 {
746 }
747 elsif(m/^\[GNUPG:\] KEYEXPIRED/)
748 {
749 }
750 elsif(m/^\[GNUPG:\] SIGEXPIRED/)
751 {
752 }
753 elsif(m/^\[GNUPG:\] NODATA/)
754 {
755 # To crash or not to crash, thats the question.
756 }
757 else
758 {
759 Error "ERROR: UNKNOWN $_\n";
760 }
761 }
762
763 while(<$stderr>)
764 {
765
766 SysLog "Received from GnuPG on stderr: $_\n";
767
768 if(m/^key ([0-9A-F]{8}): public key/)
769 {
770 #$keyid=$1;
771 }
772 }
773
774
775
776 waitpid($pid,0);
777
778 }
779
780 #$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`;
781
782 SysLog "Running GPG to export...\n";
783
784 my $do = `$gpgbin --no-tty --homedir $homedir --export --armor $keyid > $wid/result.key`;
785 SysLog $do;
786 $do = `$gpgbin --no-tty --homedir $homedir --batch --yes --delete-key $keyid 2>&1`;
787 SysLog $do;
788
789 if(open IN,"<$wid/result.key")
790 {
791 undef $/;
792 my $content=<IN>;
793 close IN;
794 $/="\n";
795
796 $content=~s/^.*-----BEGIN/-----BEGIN/s;
797 SysLog "Antworte...\n";
798 Response($ver,2,0,0,$content,"","");
799 SysLog "Done.\n";
800
801 if(!$debug)
802 {
803 unlink "$wid/request.key";
804 unlink "$wid/result.key";
805 }
806
807 }
808 else
809 {
810 SysLog "NO Resulting Key found!";
811 }
812 }
813 else
814 {
815 Error "Kann Request nicht speichern!\n";
816 }
817
818 unlink("$wid/secring.gpg");
819 unlink("$wid/pubring.gpg");
820 unlink("$wid");
821 }
822
823 sub RevokeX509
824 {
825 my ($root,$template,$hash,$days,$spkac,$request,$san,$subject)=@_;
826
827 Error "Invalid characters in SubjectAltName!\n" if($san=~m/[ \n\r\t\x00"'\\]/);
828 Error "Invalid characters in Hash!\n" if(! $subject=~m/^[0-9a-fA-F]+$/);
829
830 SysLog "Widerrufe $PkiSystems{$_[0]}\n";
831 SysLog "Aktueller Hash vom Webserver: $subject\n";
832
833 my $iscurrent=0;
834
835 $currenthash{$root}=sha1_hex(readfile("revoke-root$root.crl"));
836
837 print "Aktueller Hash vom Signingserver: $currenthash{$root}\n";
838
839 if($subject eq $currenthash{$root})
840 {
841 print "Hash matches current CRL.\n";
842 print "Deleting old CRLs...\n";
843 foreach (<currentcrls/$root/*>)
844 {
845 if($_ ne "currentcrls/$root/$subject.crl")
846 {
847 print "Deleting $_\n";
848 unlink $_ ;
849 }
850 }
851 print "Done with deleting old CRLs.\n";
852 $iscurrent=1;
853 }
854
855 my $wid=CreateWorkspace();
856
857 my $opensslcnf=X509ConfigFile($root,$template);
858
859 if(open OUT,">$wid/request.crt")
860 {
861 print OUT $request;
862 close OUT;
863
864 my $do = `$opensslbin ca $hashes{$hash} -config $opensslcnf -key test -batch -revoke $wid/request.crt > /dev/null 2>&1`;
865 $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`;
866 $do = `$opensslbin crl -inform PEM -in $wid/cacert-revoke.crl -outform DER -out $wid/revoke.crl > /dev/null 2>&1`;
867 unlink "$wid/cacert-revoke.crl";
868
869 if(open IN,"<$wid/revoke.crl")
870 {
871 undef $/;
872 my $content=<IN>;
873 close IN;
874 $/="\n";
875 unlink "$wid/revoke.crl";
876
877 mkdir "currentcrls/$root";
878 my $newcrlname="currentcrls/$root/".sha1_hex($content).".crl";
879 open OUT,">$newcrlname";
880 print OUT $content;
881 close OUT;
882
883 if($iscurrent)
884 {
885 SysLog "Schicke aktuelles Delta...\n";
886 system "xdelta delta revoke-root$root.crl $newcrlname delta$root.diff";
887 Response($ver,2,0,0,readfile("delta$root.diff"),"","");
888 #Response($ver,2,0,0,$content,"","");
889 }
890 else
891 {
892 if(-f "currentcrls/$root/$subject.crl")
893 {
894 SysLog "Schicke altes Delta...\n";
895 system "xdelta delta currentcrls/$root/$subject.crl $newcrlname delta$root.diff";
896
897 Response($ver,2,0,0,readfile("delta$root.diff"),"","");
898 #Response($ver,2,0,0,$content,"","");
899 }
900 else
901 {
902 SysLog "Out of Sync! Sending empty CRL...\n";
903 Response($ver,2,0,0,"","",""); # CRL !!!!!!!!!
904 }
905 }
906
907 open OUT,">revoke-root$root.crl";
908 print OUT $content;
909 close OUT;
910
911
912 SysLog "Done.\n";
913 }
914 }
915 unlink "$wid";
916 }
917
918
919 sub analyze($)
920 {
921 SysLog "Analysiere ...\n";
922 #SysLog hexdump($_[0])."\n";
923
924 my @fields=unpack3array(substr($_[0],3,-9));
925 Error "Wrong number of parameters: ".scalar(@fields)."\n" if(scalar(@fields)!=4);
926
927 SysLog "Header: ".hexdump($fields[0])."\n";
928 my @bytes=unpack("C*",$fields[0]);
929
930 Error "Header too short!\n" if(length($fields[0])<3);
931
932 Error "Version mismatch. Server does not support version $bytes[0], server only supports version $ver!\n" if($bytes[0]!=$ver);
933
934 Error "Header has wrong length: ".length($fields[0])."!\n" if(length($fields[0])!=9);
935
936 if($bytes[1] == 0) # NUL Request
937 {
938 SysLog "NUL Request detected.\n";
939 if($fields[1])
940 {
941 open OUT,">timesync.sh";
942 print OUT "date -u $fields[1]\n";
943 print OUT "hwclock --systohc\n";
944 close OUT;
945 }
946 Response($ver,0,0,0,"","","");
947 }
948 elsif($bytes[1]==1) # Sign Request
949 {
950 SysLog "SignRequest detected...\n";
951 CheckSystem($bytes[2],$bytes[3],$bytes[4],$bytes[5]);
952 if($bytes[2]==1)
953 {
954 SignX509($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
955 }
956 elsif($bytes[2]==2)
957 {
958 SignOpenPGP($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
959 }
960 }
961 elsif($bytes[1]==2) # Revocation Request
962 {
963 SysLog "Revocation Request ...\n";
964 CheckSystem($bytes[2],$bytes[3],$bytes[4],$bytes[5]);
965 if($bytes[2]==1)
966 {
967 RevokeX509($bytes[3],$bytes[4],$bytes[5],($bytes[6]<<8)+$bytes[7], $bytes[8],$fields[1],$fields[2],$fields[3]);
968 }
969 }
970 else
971 {
972 Error "Unknown command\n";
973 }
974
975 }
976
977 SysLog "Server started. Waiting 5 minutes for contact from client ...\n";
978
979 #When started, we wait for 5 minutes for the client to connect:
980 my @ready=$sel->can_read($starttime);
981
982
983 my $count=0;
984
985 #As soon as the client connected successfully, the client has to send a request faster than every 10 seconds
986 while(@ready = $sel->can_read(15) && -f "./server.pl-active")
987 {
988 my $data="";
989 #my $length=read SER,$data,1;
990
991 #SysLog "Data: ".hexdump($data)."\n";
992
993 #Receive();
994
995 $data=Receive();
996 SysLog "Analysing ...\n";
997 analyze($data);
998
999 # if($data eq "\x02")
1000 # {
1001 # #SysLog "Start empfangen, sende OK\n";
1002 # SendIt("\x10");
1003 #
1004 # my $block="";
1005 # my $blockfinished=0;
1006 # my $tries=10000;
1007 #
1008 # while(!$blockfinished)
1009 # {
1010 # Error "Tried reading too often\n" if(($tries--)<=0);
1011 #
1012 # $data="";
1013 # @ready = $sel->can_read(2);
1014 # $length=read SER,$data,100;
1015 # if($length)
1016 # {
1017 # $block.=$data;
1018 # }
1019 # $blockfinished=defined(unpack3(substr($block,0,-1)))?1:0;
1020 # }
1021 # #SysLog "Block done: ".hexdump($block)."\n";
1022 # if(CheckCRC($block))
1023 # {
1024 # SendIt("\x10");
1025 # analyze($block);
1026 # }
1027 # else
1028 # {
1029 # Error "CRC Error\n";
1030 # }
1031 # }
1032 # else
1033 # {
1034 # Error "Error: Wrong Startbyte!\n";
1035 # }
1036
1037 $count++;
1038
1039 SysLog "$count requests processed. Waiting on next request ...\n";
1040
1041 }
1042
1043
1044 Error "Timeout! No data from client anymore!\n";
1045