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