bug 775: changed teh duration date for the organisation certificates to 2 years for...
[cacert-devel.git] / CommModule / client.pl
1 #!/usr/bin/perl -w
2
3 # CommModule - CAcert Communication Module
4 # Copyright (C) 2006-2009 CAcert Inc.
5 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; version 2 of the License.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18
19
20 # Production Client / CommModule
21
22 use strict;
23 use Device::SerialPort qw( :PARAM :STAT 0.07 );
24 use POSIX;
25 use IO::Select;
26 use Time::HiRes q(usleep);
27 use File::CounterFile;
28 use IPC::Open3;
29 use File::Copy;
30 use DBI;
31 use Locale::gettext;
32 use IO::Socket;
33 use MIME::Base64;
34 use Digest::SHA qw(sha1_hex);
35
36 #Protocol version:
37 my $ver=1;
38
39 my $paranoid=1;
40
41 my $debug=0;
42
43 #my $serialport="/dev/ttyS0";
44 my $serialport="/dev/ttyUSB0";
45
46 my $gpgbin="/usr/bin/gpg";
47
48 my $opensslbin="/usr/bin/openssl";
49
50
51 my $mysqlphp="/home/cacert/www/includes/mysql.php";
52
53 my %revokefile=(2=>"../www/class3-revoke.crl",1=>"../www/revoke.crl");
54
55 my $newlayout=1;
56
57 #End of configurations
58
59 ########################################################
60
61
62 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);
63
64
65 my $password="";
66 if(open IN,"<$mysqlphp")
67 {
68 my $content="";
69 undef $/;
70 $content=<IN>;
71 $password=$1 if($content=~m/mysql_connect\s*\("[^"]+",\s*"\w+",\s*"(\w+)"/);
72 close IN;
73 $/="\n";
74
75 }
76 else
77 {
78 die "Could not read file: $!\n";
79 }
80
81
82 my $dbh = DBI->connect("DBI:mysql:cacert:localhost","cacert",$password, { RaiseError => 1, AutoCommit => 1 }) || die ("Error with the database connection.\n");
83
84 sub readfile($)
85 {
86 my $save=$/;
87 undef $/;
88 open READIN,"<$_[0]";
89 my $content=<READIN>;
90 close READIN;
91 $/=$save;
92 return $content;
93 }
94
95
96
97 #Logging functions:
98 my $lastdate = "";
99
100 sub SysLog($)
101 {
102 return if(not defined($_[0]));
103 my $timestamp = strftime("%Y-%m-%d %H:%M:%S", localtime);
104 my $currdate = substr($timestamp, 0, 10);
105 if ($lastdate ne $currdate) {
106 close LOG if ($lastdate ne "");
107 $lastdate = $currdate;
108 open LOG,">>logfile$lastdate.txt";
109 }
110 print LOG "$timestamp $_[0]";
111 flush LOG;
112 }
113
114 sub Error($)
115 {
116 SysLog($_[0]);
117 if($paranoid)
118 {
119 die $_[0];
120 }
121 }
122
123
124 my $timestamp=strftime("%Y-%m-%d %H:%M:%S",localtime);
125
126 #mkdir "revokehashes";
127 foreach (keys %revokefile)
128 {
129 next unless (-f $revokefile{$_});
130 my $revokehash=sha1_hex(readfile($revokefile{$_}));
131 SysLog "Root $_: Hash $revokefile{$_} = $revokehash\n";
132 }
133
134
135
136 sub mysql_query($)
137 {
138 $dbh->do($_[0]);
139 }
140
141 sub trim($)
142 {
143 my $new=$_[0];
144 $new=~s/^\s*//;
145 $new=~s/\s*$//;
146 return($new);
147 }
148 sub addslashes($)
149 {
150 my $new=$_[0];
151 $new=~s/['"\\]/\\$1/g;
152 return($new);
153 }
154
155 sub recode
156 {
157 return $_[1];
158 }
159
160
161
162 SysLog("Opening Serial interface:\n");
163 sub SerialSettings($)
164 {
165 my $PortObj=$_[0];
166 if(!defined($PortObj))
167 {
168 Error "Could not open Serial Port!\n" ;
169 }
170 else
171 {
172 $PortObj->baudrate(115200);
173 $PortObj->parity("none");
174 $PortObj->databits(8);
175 $PortObj->stopbits(1);
176 }
177 }
178
179 #We have to open the SerialPort and close it again, so that we can bind it to a Handle
180 if(! -f "serial.conf")
181 {
182 my $PortObj = new Device::SerialPort($serialport);
183 SerialSettings($PortObj);
184 $PortObj->save("serial.conf");
185 undef $PortObj;
186 }
187
188 my $PortObj = tie (*SER, 'Device::SerialPort', "serial.conf") || Error "Can't tie using Configuration_File_Name: $!\n";
189
190 Error "Could not open Serial Interface!\n" if(not defined($PortObj));
191 SerialSettings($PortObj);
192 #open SER,">$serialport";
193
194 SysLog("Serial interface opened: $PortObj\n");
195
196 my $sel = new IO::Select( \*SER );
197
198
199
200 #Hexdump function: Returns the hexdump representation of a string
201 sub hexdump($)
202 {
203 return "" if(not defined($_[0]));
204 my $content="";
205 $content.=sprintf("%02X ",unpack("C",substr($_[0],$_,1))) foreach (0 .. length($_[0])-1);
206 return $content;
207 }
208
209 #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
210 sub pack3
211 {
212 return "\x00\x00\x00" if(!defined($_[0]));
213 my $data=(length($_[0]) >= 2**24)? "":$_[0];
214 my $len=pack("N",length($data));
215 SysLog "len: ".length($data)."\n" if($debug);
216 return substr($len,1,3).$data;
217 }
218
219
220 #unpack3 unpacks packed data.
221 sub unpack3($)
222 {
223 return undef if((not defined($_[0])) or length($_[0])<3);
224 #SysLog "hexdump: ".hexdump("\x00".substr($_[0],0,3))."\n";
225 my $len=unpack("N","\x00".substr($_[0],0,3));
226 #SysLog "len3: $len length(): ".length($_[0])." length()-3: ".(length($_[0])-3)."\n";
227 return undef if(length($_[0])-3 != $len);
228 return substr($_[0],3);
229 }
230
231
232 #unpack3array extracts a whole array of concatented pack3ed data.
233 sub unpack3array($)
234 {
235 my @retarr=();
236 if((not defined($_[0])) or length($_[0])<3)
237 {
238 SysLog "Begin of structure corrupt\n";
239 return ();
240 }
241 my $dataleft=$_[0];
242 while(length($dataleft)>=3)
243 {
244 #SysLog "hexdump: ".hexdump("\x00".substr($dataleft,0,3))."\n";
245 my $len=unpack("N","\x00".substr($dataleft,0,3));
246 #SysLog "len3: $len length(): ".length($dataleft)." length()-3: ".(length($dataleft)-3)."\n";
247 if(length($dataleft)-3 < $len)
248 {
249 SysLog "Structure cut off\n";
250 return ();
251 }
252 push @retarr, substr($dataleft,3,$len);
253 $dataleft=substr($dataleft,3+$len);
254 }
255 if(length($dataleft)!=0)
256 {
257 SysLog "End of structure cut off\n";
258 return ();
259 }
260 return @retarr;
261 }
262
263
264 #Raw send function over the Serial Interface (+debugging)
265 sub SendIt($)
266 {
267 return unless defined($_[0]);
268 SysLog "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n" if($debug);
269 my $data=$_[0];
270 my $runcount=0;
271 my $total=0;
272 my $mtu=30;
273 while(length($data))
274 {
275 my $iwrote=scalar($PortObj->write(substr($data,0,$mtu)))||0;
276 #usleep(270*$iwrote+9000); # On Linux, we have to wait to make sure it is being sent, and we dont loose any data.
277 $total+=$iwrote;
278 $data=substr($data,$iwrote);
279 if ($debug) {
280 print "i wrote: $iwrote total: $total left: ".length($data)."\n" if(!($runcount++ %10));
281 }
282 }
283 SysLog "Sent message.\n" if($debug);
284 # print "Sending ".length($_[0])."\n"; #hexdump($_[0])."\n";
285 # foreach(0 .. length($_[0]))
286 # {
287 # $PortObj->write(substr($_[0],$_,1));
288 # }
289
290 }
291
292
293 my $modus=0;
294 my $cnt=0;
295
296
297 #Send data over the Serial Interface with handshaking:
298 sub SendHandshaked($)
299 {
300 SysLog "Shaking hands ...\n" if($debug);
301 SendIt("\x02");
302
303 Error "Handshake uncompleted. Connection lost2! $!\n" if(!scalar($sel->can_read(20)));
304 my $data="";
305 my $length=read SER,$data,1;
306 if($length && $data eq "\x10")
307 {
308 #print "OK ...\n";
309 my $xor=0;
310 foreach(0 .. length($_[0])-1)
311 {
312 #print "xor mit ".unpack("C",substr($_[0],$_,1))."\n";
313 $xor ^= unpack("C",substr($_[0],$_,1));
314 }
315 #print "XOR: $xor\n";
316
317 my $tryagain=1;
318 while($tryagain)
319 {
320 SendIt($_[0].pack("C",$xor)."rie4Ech7");
321
322 Error "Packet receipt was not confirmed in 5 seconds. Connection lost!\n" if(!scalar($sel->can_read(5)));
323
324 $data="";
325 $length=read SER,$data,1;
326
327 if($length && $data eq "\x10")
328 {
329 SysLog "Sent successfully!...\n";
330 $tryagain=0;
331 }
332 elsif($length && $data eq "\x11")
333 {
334 $tryagain=1;
335 }
336 else
337 {
338 Error "I cannot send! $length ".unpack("C",$data)."\n";
339 }
340 }
341
342 }
343 else
344 {
345 print "!Cannot send! $length \n";
346 Error "!Stopped sending.\n";
347 }
348 }
349
350
351
352 sub Receive
353 {
354 my $data="";
355 my @ready = $sel->can_read(120);
356
357 my $length=read SER,$data,1,0;
358
359 #SysLog "Data: ".hexdump($data)."\n";
360
361 if($data eq "\x02")
362 {
363 $modus=1;
364 SysLog "Start received, sending OK\n" if($debug);
365 SendIt("\x10");
366
367 my $block="";
368 my $blockfinished=0;
369 my $tries=100000;
370
371 while(!$blockfinished)
372 {
373 Error("Tried reading too often\n") if(($tries--)<=0);
374 # SysLog ("tries: $tries") if(!($tries%10));
375
376 $data="";
377 if(!scalar($sel->can_read(5)))
378 {
379 Error "Handshake uncompleted. Connection lost variant3! $!\n" ;
380 return;
381 }
382 $length=read SER,$data,100,0;
383 if($length)
384 {
385 $block.=$data;
386 }
387 #SysLog("Received: $length ".length($block)."\n");
388 $blockfinished=defined(unpack3(substr($block,0,-9)))?1:0;
389
390 if(!$blockfinished and substr($block,-8,8) eq "rie4Ech7")
391 {
392 SysLog "BROKEN Block detected!\n";
393 SendIt("\x11");
394 $block="";
395 $blockfinished=0;
396 $tries=100000;
397 }
398
399 }
400 SysLog "Block done: ".hexdump($block)."\n" if($debug);
401 SendIt("\x10");
402 return($block);
403 }
404 else
405 {
406 Error("Error: No Answer received, Timeout.\n") if(length($data)==0);
407 Error("Error: Wrong Startbyte: ".hexdump($data)." !\n");
408 }
409
410 SysLog "Waiting on next request ...\n";
411
412 }
413
414
415
416 # @result(Version,Action,Errorcode,Response)=Request(Version=1,Action=1,System=1,Root=1,Configuration="...",Parameter="...",Request="...");
417 sub Request($$$$$$$$$$$)
418 {
419 SysLog "Version: $_[0] Action: $_[1] System: $_[2] Root: $_[3] Config: $_[4]\n";
420 $_[3]=0 if($_[3]<0);
421 SendHandshaked(pack3(pack3(pack("C*",$_[0],$_[1],$_[2],$_[3],$_[4],$_[5],$_[6]>>8,$_[6]&255,$_[7])).pack3($_[8]).pack3($_[9]).pack3($_[10])));
422 my $data=Receive();
423 my @fields=unpack3array(substr($data,3,-9));
424
425 SysLog "Answer from Server: ".hexdump($data)."\n" if($debug);
426
427 #if(open OUT,">result.dat")
428 #{
429 # print OUT $data;
430 # close OUT;
431 #}
432 #else
433 #{
434 # SysLog "Could not write result: $!\n";
435 #}
436 return $fields[1];
437 }
438
439
440 sub calculateDays($)
441 {
442 if($_[0])
443 {
444 my @sum = $dbh->selectrow_array("select sum(`points`) as `total` from `notary` where `to`='".$_[0]."' and `deleted`=0 group by `to`");
445 SysLog("Summe: $sum[0]\n") if($debug);
446
447 return ($sum[0]>=50)?730:180;
448 }
449 return 180;
450 }
451
452 sub X509extractSAN($)
453 {
454 my @bits = split("/", $_[0]);
455 my $SAN="";
456 my $newsubject="";
457 foreach my $val(@bits)
458 {
459 my @bit=split("=",$val);
460 if($bit[0] eq "subjectAltName")
461 {
462 $SAN.="," if($SAN ne "");
463 $SAN.= trim($bit[1]);
464 }
465 else
466 {
467 $newsubject .= "/".$val;
468 }
469 }
470 $newsubject=~s{^//}{/};
471 $newsubject=~s/[\n\r\t\x00"\\']//g;
472 $SAN=~s/[ \n\r\t\x00"\\']//g;
473 return($SAN,$newsubject);
474 }
475
476 sub X509extractExpiryDate($)
477 {
478 # TIMEZONE ?!?
479 my $data=`$opensslbin x509 -in "$_[0]" -noout -enddate`;
480
481 #notAfter=Aug 8 10:26:34 2007 GMT
482 if($data=~m/notAfter=(\w{2,4}) *(\d{1,2}) *(\d{1,2}:\d{1,2}:\d{1,2}) (\d{4}) GMT/)
483 {
484 my $date="$4-".$monarr{$1}."-$2 $3";
485 SysLog "Expiry Date found: $date\n" if($debug);
486 return $date;
487 }
488 else
489 {
490 SysLog "Expiry Date not found: $data\n";
491 }
492 return "";
493 }
494
495 sub CRLuptodate($)
496 {
497 return 0 unless(-f $_[0]);
498 my $data=`$opensslbin crl -in "$_[0]" -noout -lastupdate -inform der`;
499 SysLog "CRL: $data\n";
500 #lastUpdate=Aug 8 10:26:34 2007 GMT
501 # Is the timezone handled properly?
502 if($data=~m/lastUpdate=(\w{2,4}) *(\d{1,2}) *(\d{1,2}:\d{1,2}:\d{1,2}) (\d{4}) GMT/)
503 {
504 my $date=sprintf("%04d-%02d-%02d",$4,$monarr{$1},$2);
505 SysLog "CRL Issueing Date found: $date\n" if($debug);
506 my $compare = strftime("%Y-%m-%d", localtime);
507 SysLog "Comparing $date with $compare\n" if($debug);
508 return $date eq $compare;
509 }
510 else
511 {
512 SysLog "Expiry Date not found. Perhaps DER format is necessary? Hint: $data\n";
513 }
514 return 0;
515 }
516
517
518 sub X509extractSerialNumber($)
519 {
520 # TIMEZONE ?!?
521 my $data=`$opensslbin x509 -in "$_[0]" -noout -serial`;
522 if($data=~m/serial=([0-9A-F]+)/)
523 {
524 return $1;
525 }
526 return "";
527 }
528
529 sub OpenPGPextractExpiryDate ($)
530 {
531 my $r="";
532 my $cts;
533 my @date;
534
535 open(RGPG, $gpgbin.' -vv '.$_[0].' 2>&1 |') or Error('Can\'t start GnuPG($gpgbin): '.$!."\n");
536 open(OUT, '> infogpg.txt' ) or Error('Can\'t open output file: infogpg.txt: '.$!);
537 $/="\n";
538 while (<RGPG>)
539 {
540 print OUT $_;
541 unless ($r)
542 {
543 if ( /^\s*version \d+, created (\d+), md5len 0, sigclass (?:0x[0-9a-fA-F]+|\d+)\s*$/ )
544 {
545 SysLog "Detected CTS: $1\n";
546 $cts = int($1);
547 } elsif ( /^\s*critical hashed subpkt \d+ len \d+ \(sig expires after ((\d+)y)?((\d+)d)?((\d+)h)?(\d+)m\)\s*$/ )
548 {
549 SysLog "Detected FRAME $2 $4 $6 $8\n";
550 $cts += $2 * 31536000; # secs per year (60 * 60 * 24 * 365)
551 $cts += $4 * 86400; # secs per day (60 * 60 * 24)
552 $cts += $6 * 3600; # secs per hour (60 * 60)
553 $cts += $8 * 60; # secs per min (60)
554 $r = $cts;
555 }
556 elsif(/version/)
557 {
558 SysLog "Detected VERSION\n";
559 }
560 }
561 }
562
563 close(OUT );
564 close(RGPG);
565
566 SysLog "CTS: $cts R: $r\n";
567
568 if ( $r )
569 {
570 @date = gmtime($r);
571 $r = sprintf('%.4i-%.2i-%.2i %.2i:%.2i:%.2i', # date format
572 $date[5] + 1900, $date[4] + 1, $date[3], # day
573 $date[2], $date[1], $date[0], # time
574 );
575
576 }
577 SysLog "$r\n";
578 return $r;
579 }
580
581 #sub OpenPGPextractExpiryDate($)
582 #{
583 # my $data=`$gpgbin -v $_[0]`;
584 # open OUT,">infogpg.txt";
585 # print OUT $data;
586 # close OUT;
587 # if($data=~m/^sig\s+[0-9A-F]{8} (\d{4}-\d\d-\d\d) [^\[]/)
588 # {
589 # return "$1 00:00:00";
590 # }
591 # return "";
592 #}
593
594
595 # Sets the locale according to the users preferred language
596 sub setUsersLanguage($)
597 {
598 my $lang="en_US";
599 print "Searching for the language of the user $_[0]\n";
600 my @a=$dbh->selectrow_array("select language from users where id='".int($_[0])."'");
601 $lang = $1 if($a[0]=~m/(\w+_[\w.@]+)/);
602
603 SysLog "The users preferred language: $lang\n";
604
605 if($lang ne "")
606 {
607 $ENV{"LANG"}=$lang;
608 setlocale(LC_ALL, $lang);
609 } else {
610 $ENV{"LANG"}="en_AU";
611 setlocale(LC_ALL, "en_AU");
612 }
613 }
614
615
616 sub getUserData($)
617 {
618 return() unless($_[0]=~m/^\d+$/);
619 my $sth = $dbh->prepare("select * from users where id='$_[0]'");
620 $sth->execute();
621 #SysLog "USER DUMP:\n";
622 while ( my $rowdata = $sth->fetchrow_hashref() )
623 {
624 my %tmp=%{$rowdata};
625 #foreach (sort keys %tmp)
626 #{
627 #SysLog " $_ -> $tmp{$_}\n";
628 #}
629 return %tmp;
630 }
631 return ();
632 }
633
634
635 sub _($)
636 {
637 return gettext($_[0]);
638 }
639
640 sub sendmail($$$$$$$)
641 {
642 my ($to, $subject, $message, $from, $replyto, $toname, $fromname)=@_;
643 my $errorsto="returns\@cacert.org";
644 my $extra="";
645
646
647 # sendmail($user{email}, "[CAcert.org] Your GPG/PGP Key", $body, "support\@cacert.org", "", "", "CAcert Support");
648 my @lines=split("\n",$message);
649 $message = "";
650 foreach my $line (@lines)
651 {
652 $line = trim($line);
653 if($line eq ".")
654 {
655 $message .= " .\n";
656 } else
657 {
658 $message .= $line."\n";
659 }
660 }
661
662 $fromname = $from if($fromname eq "");
663
664 my @bits = split(",", $from);
665 $from = addslashes($bits['0']);
666 $fromname = addslashes($fromname);
667
668 my $smtp = IO::Socket::INET->new(PeerAddr => 'localhost:25');
669 $/="\n";
670 SysLog "SMTP: ".<$smtp>;
671 print $smtp "HELO hlin.cacert.org\r\n";
672 SysLog "SMTP: ".<$smtp>;
673 print $smtp "MAIL FROM:<returns\@cacert.org>\r\n";
674 SysLog "MAIL FROM: ".<$smtp>;
675
676 @bits = split(",", $to);
677 foreach my $user (@bits)
678 {
679 print $smtp "RCPT TO:<".trim($user).">\r\n";
680 SysLog "RCPT TO: ".<$smtp>;
681 }
682 print $smtp "DATA\r\n";
683 SysLog "DATA: ".<$smtp>;
684
685 print $smtp "X-Mailer: CAcert.org Website\r\n";
686 print $smtp "X-OriginatingIP: ".$ENV{"REMOTE_ADDR"}."\r\n";
687 print $smtp "Sender: $errorsto\r\n";
688 print $smtp "Errors-To: $errorsto\r\n";
689 if($replyto ne "")
690 {
691 print $smtp "Reply-To: $replyto\r\n";
692 }
693 else
694 {
695 print $smtp "Reply-To: $from\r\n";
696 }
697 print $smtp "From: $from ($fromname)\r\n";
698 print $smtp "To: $to\r\n";
699 my $newsubj=encode_base64(recode("html..utf-8", trim($subject)));
700 #SysLog("NewSubj: --".$newsubj."--\n") if($debug);
701 $newsubj=~s/\n*$//;
702 #SysLog("NewSubj: --".$newsubj."--\n") if($debug);
703 print $smtp trim($subject)=~m/[^a-zA-Z0-9 ,.\[\]\/-]/?"Subject: =?utf-8?B?$newsubj?=\r\n":"Subject: $subject\r\n";
704 print $smtp "Mime-Version: 1.0\r\n";
705 if($extra eq "")
706 {
707 print $smtp "Content-Type: text/plain; charset=\"utf-8\"\r\n";
708 print $smtp "Content-Transfer-Encoding: 8bit\r\n";
709 }
710 else
711 {
712 print $smtp "Content-Type: text/plain; charset=\"iso-8859-1\"\r\n";
713 print $smtp "Content-Transfer-Encoding: quoted-printable\r\n";
714 print $smtp "Content-Disposition: inline\r\n";
715 };
716 # print $smtp "Content-Transfer-Encoding: BASE64\r\n";
717 print $smtp "\r\n";
718 # print $smtp chunk_split(encode_base64(recode("html..utf-8", $message)))."\r\n.\r\n";
719 print $smtp recode("html..utf-8", $message)."\r\n.\r\n";
720 SysLog "ENDOFTEXT: ".<$smtp>;
721 print $smtp "QUIT\n";
722 SysLog "QUIT: ".<$smtp>;
723 close($smtp);
724 }
725
726
727 sub HandleCerts($$)
728 {
729 my $org=$_[0]?"org":"";
730 my $server=$_[1];
731
732
733 my $table=$org.($server?"domaincerts":"emailcerts");
734
735 SysLog "HandleCerts $table\n";
736
737 my $sth = $dbh->prepare("select * from $table where crt_name='' and csr_name!='' and warning<3");
738 $sth->execute();
739 #$rowdata;
740 while ( my $rowdata = $sth->fetchrow_hashref() )
741 {
742 my %row=%{$rowdata};
743 my $prefix=$org.($server?"server":"client");
744 my $short=int($row{'id'}/1000);
745 my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
746 $csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
747 SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
748
749 #my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
750 my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
751 my $dirname=$crtname; $dirname=~s/\/[^\/]*\.crt//;
752 mkdir $dirname,0777;
753 SysLog("New Layout: $crtname\n");
754
755 if($server)
756 {
757 #Weird SQL structure ...
758 my @sqlres=$dbh->selectrow_array("select memid from domains where id='".int($row{'domid'})."'");
759 $row{'memid'}=$sqlres[0];
760 SysLog("Fetched memid: $row{'memid'}\n") if($debug);
761 }
762
763 SysLog "Opening $csrname\n";
764
765 my $crt="";
766
767 my $profile=0;
768
769 # "0"=>"client.cnf",
770 # "1"=>"client-org.cnf",
771 # "2"=>"client-codesign.cnf",
772 # "3"=>"client-machine.cnf",
773 # "4"=>"client-ads.cnf",
774 # "5"=>"server.cnf",
775 # "6"=>"server-org.cnf",
776 # "7"=>"server-jabber.cnf",
777 # "8"=>"server-ocsp.cnf",
778 # "9"=>"server-timestamp.cnf",
779 # "10"=>"proxy.cnf",
780 # "11"=>"subca.cnf"
781
782
783 if($row{"type"} =~ m/^(8|9)$/)
784 {
785 $profile=$row{"type"};
786 }
787 elsif($org)
788 {
789 if($row{'codesign'})
790 {
791 $profile=2; ## TODO!
792 }
793 elsif($server)
794 {
795 $profile=6;
796 }
797 else
798 {
799 $profile=1;
800 }
801 }
802 else
803 {
804 if($row{'codesign'})
805 {
806 $profile=2;
807 }
808 elsif($server)
809 {
810 $profile=5;
811 }
812 else
813 {
814 $profile=0;
815 }
816
817
818 }
819
820
821
822 if(open(IN,"<$csrname"))
823 {
824 undef $/;
825 my $content=<IN>;
826 close IN;
827 SysLog "Read $csrname.\n" if($debug);
828 SysLog "Subject: --$row{'subject'}--\n" if($debug);
829
830 my ($SAN,$subject)=X509extractSAN($row{'subject'});
831 SysLog "Subject: --$subject--\n" if($debug);
832 SysLog "SAN: --$SAN--\n" if($debug);
833 SysLog "memid: $row{'memid'}\n" if($debug);
834
835 my $days=$org?730:calculateDays($row{"memid"});
836
837 my $md_id = 0;
838 $md_id = 1 if( $row{'md'} eq "md5");
839 $md_id = 2 if( $row{'md'} eq "sha1");
840 $md_id = 3 if( $row{'md'} eq "rmd160");
841 $md_id = 8 if( $row{'md'} eq "sha256");
842 $md_id = 9 if( $row{'md'} eq "sha384");
843 $md_id =10 if( $row{'md'} eq "sha512");
844
845 $crt=Request($ver,1,1,$row{'rootcert'}-1,$profile,$md_id,$days,$row{'keytype'}eq"NS"?1:0,$content,$SAN,$subject);
846 if(length($crt))
847 {
848 if($crt=~m/^-----BEGIN CERTIFICATE-----/)
849 {
850 open OUT,">$crtname";
851 print OUT $crt;
852 close OUT;
853 }
854 else
855 {
856 open OUT,">$crtname.der";
857 print OUT $crt;
858 close OUT;
859 system "$opensslbin x509 -in $crtname.der -inform der -out $crtname";
860 }
861 }
862 else
863 {
864 SysLog "ZERO Length certificate received.\n";
865 }
866 }
867 else
868 {
869 print "Error: $! Konnte $csrname nicht laden\n";
870 }
871
872
873
874 if(-s $crtname)
875 {
876 SysLog "Opening $crtname\n";
877
878 my $date=X509extractExpiryDate($crtname);
879 my $serial=X509extractSerialNumber($crtname);
880
881 setUsersLanguage($row{memid});
882
883 my %user=getUserData($row{memid});
884
885 foreach (sort keys %user)
886 {
887 SysLog " $_ -> $user{$_}\n" if($debug);
888 }
889
890 SysLog("update `$table` set `crt_name`='$crtname', modified=now(), serial='$serial', `expire`='$date' where `id`='".$row{'id'}."'\n");
891
892 $dbh->do("update `$table` set `crt_name`='$crtname', modified=now(), serial='$serial', `expire`='$date' where `id`='".$row{'id'}."'");
893
894 my $body = _("Hi")." $user{fname},\n\n";
895 $body .= sprintf(_("You can collect your certificate for %s by going to the following location:")."\n\n", $row{'email'}.$row{'CN'});
896 $body .= "https://www.cacert.org/account.php?id=".($server?"15":"6")."&cert=$row{id}\n\n";
897 $body .= _("If you have not imported CAcert's root certificate, please go to:")."\n";
898 $body .= "https://www.cacert.org/index.php?id=3\n";
899 $body .= "Root cert fingerprint = A6:1B:37:5E:39:0D:9C:36:54:EE:BD:20:31:46:1F:6B\n";
900 $body .= "Root cert fingerprint = 135C EC36 F49C B8E9 3B1A B270 CD80 8846 76CE 8F33\n\n";
901 $body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
902 sendmail($user{email}, "[CAcert.org] "._("Your certificate"), $body, "support\@cacert.org", "", "", "CAcert Support");
903 }
904 else
905 {
906 SysLog("Could not find the issued certificate. $crtname ".$row{"id"}."\n");
907 $dbh->do("update `$table` set warning=warning+1 where `id`='".$row{'id'}."'");
908 }
909 }
910 }
911
912
913 sub DoCRL($$)
914 {
915 my $crl=$_[0];
916 my $crlname=$_[1];
917
918 if(length($crl))
919 {
920 if($crl=~m/^-----BEGIN X509 CRL-----/)
921 {
922 open OUT,">$crlname.pem";
923 print OUT $crl;
924 close OUT;
925 system "$opensslbin crl -in $crlname.pem -outform der -out $crlname.tmp";
926 }
927 else
928 {
929 open OUT,">$crlname.patch";
930 print OUT $crl;
931 close OUT;
932 my $res=system "xdelta patch $crlname.patch $crlname $crlname.tmp";
933 #print "xdelta res: $res\n";
934 if($res==512)
935 {
936 open OUT,">$crlname.tmp";
937 print OUT $crl;
938 close OUT;
939 }
940 }
941
942 my $res=`openssl crl -verify -in $crlname.tmp -inform der -noout 2>&1`;
943 SysLog "verify: $res\n";
944 if($res=~m/verify OK/)
945 {
946 rename "$crlname.tmp","$crlname";
947 }
948 else
949 {
950 SysLog "VERIFICATION OF NEW CRL DID NOT SUCCEED! PLEASE REPAIR!\n";
951 SysLog "Broken CRL is available as $crlname.tmp\n";
952 #Override for testing:
953 rename "$crlname.tmp","$crlname";
954 }
955 return 1;
956 }
957 else
958 {
959 SysLog("RECEIVED AN EMPTY CRL!\n");
960 }
961 return 0;
962 }
963
964
965 sub RefreshCRLs()
966 {
967 foreach my $rootcert (keys %revokefile)
968 {
969 if(!CRLuptodate($revokefile{$rootcert}))
970 {
971 SysLog "Update of the CRL $rootcert is necessary!\n";
972 my $crlname = $revokefile{$rootcert};
973 my $revokehash=sha1_hex(readfile($crlname));
974 my $crl=Request($ver,2,1,$rootcert-1,0,0,365,0,"","",$revokehash);
975 #print "Received ".length($crl)." ".hexdump($crl)."\n";
976 DoCRL($crl,$crlname);
977 }
978 }
979 }
980
981
982 sub RevokeCerts($$)
983 {
984 my $org=$_[0]?"org":"";
985 my $server=$_[1];
986
987 my $table=$org.($server?"domaincerts":"emailcerts");
988
989 my $sth = $dbh->prepare("select * from $table where revoked='1970-01-01 10:00:01'"); # WHICH TIMEZONE?
990 $sth->execute();
991 #$rowdata;
992 while ( my $rowdata = $sth->fetchrow_hashref() )
993 {
994 my %row=%{$rowdata};
995
996 my $prefix=$org.($server?"server":"client");
997 my $short=int($row{'id'}/1000);
998
999 my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
1000 $csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
1001 SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
1002
1003 #my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
1004 my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
1005 SysLog("New Layout: $crtname\n");
1006
1007 #my $csrname = "../csr/".$org.($server?"server-":"client-").$row{'id'}.".csr";
1008 #my $crtname = "../crt/".$org.($server?"server-":"client-").$row{'id'}.".crt";
1009 my $crlname = $revokefile{$row{'rootcert'}};
1010
1011 my $crt="";
1012
1013
1014 if(open(IN,"<$crtname"))
1015 {
1016 undef $/;
1017 my $content=<IN>;
1018 close IN;
1019 my $revokehash=sha1_hex(readfile($crlname));
1020
1021 my $crl=Request($ver,2,1,$row{'rootcert'}-1,0,0,365,0,$content,"",$revokehash);
1022 my $result=DoCRL($crl,$crlname);
1023
1024 if($result)
1025 {
1026 setUsersLanguage($row{memid});
1027
1028 my %user=getUserData($row{memid});
1029
1030 $dbh->do("update `$table` set `revoked`=now() where `id`='".$row{'id'}."'");
1031
1032 my $body = _("Hi")." $user{fname},\n\n";
1033 $body .= sprintf(_("Your certificate for %s has been revoked, as per request.")."\n\n", $row{'CN'});
1034 $body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
1035 SysLog("Sending email to ".$user{"email"}."\n") if($debug);
1036 sendmail($user{email}, "[CAcert.org] "._("Your certificate"), $body, "support\@cacert.org", "", "", "CAcert Support");
1037 }
1038
1039 }
1040 else
1041 {
1042 SysLog("Error in RevokeCerts: $crtname $!\n") if($debug);
1043 }
1044
1045 }
1046
1047 }
1048
1049
1050
1051
1052 sub HandleGPG()
1053 {
1054 my $sth = $dbh->prepare("select * from gpg where crt='' and csr!='' ");
1055 $sth->execute();
1056 my $rowdata;
1057 while ( $rowdata = $sth->fetchrow_hashref() )
1058 {
1059 my %row=%{$rowdata};
1060
1061 my $prefix="gpg";
1062 my $short=int($row{'id'}/1000);
1063 my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
1064 $csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
1065 SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
1066
1067 #my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
1068 my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
1069 SysLog("New Layout: $crtname\n");
1070
1071
1072 #my $csrname = "../csr/gpg-".$row{'id'}.".csr";
1073 #my $crtname = "../crt/gpg-".$row{'id'}.".crt";
1074
1075 SysLog "Opening $csrname\n";
1076
1077 my $crt="";
1078
1079 if(-s $csrname && open(IN,"<$csrname"))
1080 {
1081 undef $/;
1082 my $content=<IN>;
1083 close IN;
1084 SysLog "Read $csrname.\n";
1085 $crt=Request($ver,1,2,0,0,2,366,0,$content,"","");
1086 if(length($crt))
1087 {
1088 open OUT,">$crtname";
1089 print OUT $crt;
1090 close OUT;
1091 }
1092
1093 }
1094 else
1095 {
1096 #Error("Error: $!\n");
1097 next;
1098 }
1099
1100 if(-s $crtname)
1101 {
1102 SysLog "Opening $crtname\n";
1103 setUsersLanguage($row{memid});
1104
1105 my $date=OpenPGPextractExpiryDate($crtname);
1106 my %user=getUserData($row{memid});
1107
1108 $dbh->do("update `gpg` set `crt`='$crtname', issued=now(), `expire`='$date' where `id`='".$row{'id'}."'");
1109
1110 my $body = _("Hi")." $user{fname},\n\n";
1111 $body .= sprintf(_("Your CAcert signed key for %s is available online at:")."\n\n", $row{'email'});
1112 $body .= "https://www.cacert.org/gpg.php?id=3&cert=$row{id}\n\n";
1113 $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";
1114 $body .= "pub 1024D/65D0FD58 2003-07-11 CA Cert Signing Authority (Root CA) <gpg\@cacert.org>\n";
1115 $body .= "Key fingerprint = A31D 4F81 EF4E BD07 B456 FA04 D2BB 0D01 65D0 FD58\n\n";
1116 $body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
1117 sendmail($user{email}, "[CAcert.org] Your GPG/PGP Key", $body, "support\@cacert.org", "", "", "CAcert Support");
1118 } else {
1119 SysLog("Could not find the issued gpg key. ".$row{"id"}."\n");
1120 #$dbh->do("delete from `gpg` where `id`='".$row{'id'}."'");
1121 }
1122 }
1123 }
1124
1125
1126 # Main program loop
1127
1128 my $crlcheck=0;
1129
1130 while ( -f "./client.pl-active" )
1131 {
1132 SysLog("Handling GPG database ...\n");
1133 HandleGPG();
1134 SysLog("Issueing certs ...\n");
1135 HandleCerts(0,0); #personal client certs
1136 HandleCerts(0,1); #personal server certs
1137 HandleCerts(1,0); #org client certs
1138 HandleCerts(1,1); #org server certs
1139 SysLog("Revoking certs ...\n");
1140 RevokeCerts(0,0); #personal client certs
1141 RevokeCerts(0,1); #personal server certs
1142 RevokeCerts(1,0); #org client certs
1143 RevokeCerts(1,1); #org server certs
1144
1145 $crlcheck++;
1146 RefreshCRLs() if(($crlcheck%100) == 1);
1147
1148 #print "Sign Request X.509, Root0\n";
1149 #my $reqcontent="";
1150 #Request($ver,1,1,0,5,2,365,0,$reqcontent,"","/CN=supertest.cacert.at");
1151
1152 SysLog("NUL Request:\n");
1153 my $timestamp=strftime("%m%d%H%M%Y.%S",gmtime);
1154 Request($ver,0,0,0,0,0,0,0,$timestamp,"","");
1155 sleep(1);
1156 usleep(1700000);
1157 }