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