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::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");
  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]."' 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="de_DE";
 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?($server?(365*2):365):calculateDays($row{"memid"});
 836
 837
 838       $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);
 839       if(length($crt))
 840       {
 841         if($crt=~m/^-----BEGIN CERTIFICATE-----/)
 842         {
 843           open OUT,">$crtname";
 844           print OUT $crt;
 845           close OUT;
 846         }
 847         else
 848         {
 849           open OUT,">$crtname.der";
 850           print OUT $crt;
 851           close OUT;
 852           system "$opensslbin x509 -in $crtname.der -inform der -out $crtname";
 853         }
 854       }
 855       else
 856       {
 857         SysLog "ZERO Length certificate received.\n";
 858       }
 859     }
 860     else
 861     {
 862       print "Error: $! Konnte $csrname nicht laden\n";
 863     }
 864
 865
 866
 867     if(-s $crtname)
 868     {
 869       SysLog "Opening $crtname\n";
 870
 871       my $date=X509extractExpiryDate($crtname);
 872       my $serial=X509extractSerialNumber($crtname);
 873
 874       setUsersLanguage($row{memid});
 875
 876       my %user=getUserData($row{memid});
 877
 878       foreach (sort keys %user)
 879       {
 880         SysLog "  $_ -> $user{$_}\n" if($debug);
 881       }
 882
 883       SysLog("update `$table` set `crt_name`='$crtname', modified=now(), serial='$serial', `expire`='$date' where `id`='".$row{'id'}."'\n");
 884
 885       $dbh->do("update `$table` set `crt_name`='$crtname', modified=now(), serial='$serial', `expire`='$date' where `id`='".$row{'id'}."'");
 886
 887       my $body = _("Hi")." $user{fname},\n\n";
 888       $body .= sprintf(_("You can collect your certificate for %s by going to the following location:")."\n\n", $row{'email'}.$row{'CN'});
 889       $body .= "https://www.cacert.org/account.php?id=".($server?"15":"6")."&cert=$row{id}\n\n";
 890       $body .= _("If you have not imported CAcert´s root certificate, please go to:")."\n";
 891       $body .= "https://www.cacert.org/index.php?id=3\n";
 892       $body .= "Root cert fingerprint = A6:1B:37:5E:39:0D:9C:36:54:EE:BD:20:31:46:1F:6B\n";
 893       $body .= "Root cert fingerprint = 135C EC36 F49C B8E9 3B1A B270 CD80 8846 76CE 8F33\n\n";
 894       $body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
 895       sendmail($user{email}, "[CAcert.org] "._("Your certificate"), $body, "support\@cacert.org", "", "", "CAcert Support");
 896     }
 897     else
 898     {
 899       SysLog("Could not find the issued certificate. $crtname ".$row{"id"}."\n");
 900       $dbh->do("update `$table` set warning=warning+1 where `id`='".$row{'id'}."'");
 901     }
 902   }
 903 }
 904
 905
 906 sub DoCRL($$)
 907 {
 908   my $crl=$_[0];
 909   my $crlname=$_[1];
 910
 911   if(length($crl))
 912   {
 913     if($crl=~m/^-----BEGIN X509 CRL-----/)
 914     {
 915       open OUT,">$crlname.pem";
 916       print OUT $crl;
 917       close OUT;
 918       system "$opensslbin crl -in $crlname.pem -outform der -out $crlname.tmp";
 919     }
 920     else
 921     {
 922       open OUT,">$crlname.patch";
 923       print OUT $crl;
 924       close OUT;
 925       my $res=system "xdelta patch $crlname.patch $crlname $crlname.tmp";
 926       #print "xdelta res: $res\n";
 927       if($res==512)
 928       {
 929         open OUT,">$crlname.tmp";
 930         print OUT $crl;
 931         close OUT;
 932       }
 933     }
 934
 935     my $res=`openssl crl -verify -in $crlname.tmp -inform der -noout 2>&1`;
 936     SysLog "verify: $res\n";
 937     if($res=~m/verify OK/)
 938     {
 939       rename "$crlname.tmp","$crlname";
 940     }
 941     else
 942     {
 943       SysLog "VERIFICATION OF NEW CRL DID NOT SUCCEED! PLEASE REPAIR!\n";
 944       SysLog "Broken CRL is available as $crlname.tmp\n";
 945       #Override for testing:
 946       rename "$crlname.tmp","$crlname";
 947     }
 948     return 1;
 949   }
 950   else
 951   {
 952     SysLog("RECEIVED AN EMPTY CRL!\n");
 953   }
 954   return 0;
 955 }
 956
 957
 958 sub RefreshCRLs()
 959 {
 960   foreach my $rootcert (keys %revokefile)
 961   {
 962     if(!CRLuptodate($revokefile{$rootcert}))
 963     {
 964       SysLog "Update of the CRL $rootcert is necessary!\n";
 965       my $crlname = $revokefile{$rootcert};
 966       my $revokehash=sha1_hex(readfile($crlname));
 967       my $crl=Request($ver,2,1,$rootcert-1,0,0,365,0,"","",$revokehash);
 968       #print "Received ".length($crl)." ".hexdump($crl)."\n";
 969       DoCRL($crl,$crlname);
 970     }
 971   }
 972 }
 973
 974
 975 sub RevokeCerts($$)
 976 {
 977   my $org=$_[0]?"org":"";
 978   my $server=$_[1];
 979
 980   my $table=$org.($server?"domaincerts":"emailcerts");
 981
 982   my $sth = $dbh->prepare("select * from $table where revoked='1970-01-01 10:00:01'"); # WHICH TIMEZONE?
 983   $sth->execute();
 984   #$rowdata;
 985   while ( my $rowdata = $sth->fetchrow_hashref() )
 986   {
 987     my %row=%{$rowdata};
 988
 989     my $prefix=$org.($server?"server":"client");
 990     my $short=int($row{'id'}/1000);
 991
 992     my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
 993     $csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
 994     SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
 995
 996     #my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
 997     my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
 998     SysLog("New Layout: $crtname\n");
 999
1000     #my $csrname = "../csr/".$org.($server?"server-":"client-").$row{'id'}.".csr";
1001     #my $crtname = "../crt/".$org.($server?"server-":"client-").$row{'id'}.".crt";
1002     my $crlname = $revokefile{$row{'rootcert'}};
1003
1004     my $crt="";
1005
1006
1007     if(open(IN,"<$crtname"))
1008     {
1009       undef $/;
1010       my $content=<IN>;
1011       close IN;
1012       my $revokehash=sha1_hex(readfile($crlname));
1013
1014       my $crl=Request($ver,2,1,$row{'rootcert'}-1,0,0,365,0,$content,"",$revokehash);
1015       my $result=DoCRL($crl,$crlname);
1016
1017       if($result)
1018       {
1019         setUsersLanguage($row{memid});
1020
1021         my %user=getUserData($row{memid});
1022
1023         $dbh->do("update `$table` set `revoked`=now() where `id`='".$row{'id'}."'");
1024
1025         my $body = _("Hi")." $user{fname},\n\n";
1026         $body .= sprintf(_("Your certificate for %s has been revoked, as per request.")."\n\n", $row{'CN'});
1027         $body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
1028         SysLog("Sending email to ".$user{"email"}."\n") if($debug);
1029         sendmail($user{email}, "[CAcert.org] "._("Your certificate"), $body, "support\@cacert.org", "", "", "CAcert Support");
1030       }
1031
1032     }
1033     else
1034     {
1035       SysLog("Error in RevokeCerts: $crtname $!\n") if($debug);
1036     }
1037
1038   }
1039
1040 }
1041
1042
1043
1044
1045 sub HandleGPG()
1046 {
1047   my $sth = $dbh->prepare("select * from gpg where crt='' and csr!='' ");
1048   $sth->execute();
1049   my $rowdata;
1050   while ( $rowdata = $sth->fetchrow_hashref() )
1051   {
1052     my %row=%{$rowdata};
1053
1054     my $prefix="gpg";
1055     my $short=int($row{'id'}/1000);
1056     my $csrname = "../csr/$prefix-".$row{'id'}.".csr";
1057     $csrname = "../csr/$prefix/$short/$prefix-".$row{'id'}.".csr" if($newlayout);
1058     SysLog("New Layout: "."../csr/$prefix/$short/$prefix-".$row{'id'}.".csr\n");
1059
1060     #my $crtname = "../crt/$prefix-".$row{'id'}.".crt";
1061     my $crtname=$csrname; $crtname=~s/^\.\.\/csr/..\/crt/; $crtname=~s/\.csr$/.crt/;
1062     SysLog("New Layout: $crtname\n");
1063
1064
1065     #my $csrname = "../csr/gpg-".$row{'id'}.".csr";
1066     #my $crtname = "../crt/gpg-".$row{'id'}.".crt";
1067
1068     SysLog "Opening $csrname\n";
1069
1070     my $crt="";
1071
1072     if(-s $csrname && open(IN,"<$csrname"))
1073     {
1074       undef $/;
1075       my $content=<IN>;
1076       close IN;
1077       SysLog "Read $csrname.\n";
1078       $crt=Request($ver,1,2,0,0,2,366,0,$content,"","");
1079       if(length($crt))
1080       {
1081         open OUT,">$crtname";
1082         print OUT $crt;
1083         close OUT;
1084       }
1085
1086     }
1087     else
1088     {
1089       #Error("Error: $!\n");
1090       next;
1091     }
1092
1093     if(-s $crtname)
1094     {
1095       SysLog "Opening $crtname\n";
1096       setUsersLanguage($row{memid});
1097
1098       my $date=OpenPGPextractExpiryDate($crtname);
1099       my %user=getUserData($row{memid});
1100
1101       $dbh->do("update `gpg` set `crt`='$crtname', issued=now(), `expire`='$date' where `id`='".$row{'id'}."'");
1102
1103       my $body = _("Hi")." $user{fname},\n\n";
1104       $body .= sprintf(_("Your CAcert signed key for %s is available online at:")."\n\n", $row{'email'});
1105       $body .= "https://www.cacert.org/gpg.php?id=3&cert=$row{id}\n\n";
1106       $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";
1107       $body .= "pub 1024D/65D0FD58 2003-07-11 CA Cert Signing Authority (Root CA) <gpg\@cacert.org>\n";
1108       $body .= "Key fingerprint = A31D 4F81 EF4E BD07 B456 FA04 D2BB 0D01 65D0 FD58\n\n";
1109       $body .= _("Best regards")."\n"._("CAcert.org Support!")."\n\n";
1110       sendmail($user{email}, "[CAcert.org] Your GPG/PGP Key", $body, "support\@cacert.org", "", "", "CAcert Support");
1111     } else {
1112       SysLog("Could not find the issued gpg key. ".$row{"id"}."\n");
1113       #$dbh->do("delete from `gpg` where `id`='".$row{'id'}."'");
1114     }
1115   }
1116 }
1117
1118
1119 # Main program loop
1120
1121 my $crlcheck=0;
1122
1123 while ( -f "./client.pl-active" )
1124 {
1125   SysLog("Handling GPG database ...\n");
1126   HandleGPG();
1127   SysLog("Issueing certs ...\n");
1128   HandleCerts(0,0); #personal client certs
1129   HandleCerts(0,1); #personal server certs
1130   HandleCerts(1,0); #org client certs
1131   HandleCerts(1,1); #org server certs
1132   SysLog("Revoking certs ...\n");
1133   RevokeCerts(0,0); #personal client certs
1134   RevokeCerts(0,1); #personal server certs
1135   RevokeCerts(1,0); #org client certs
1136   RevokeCerts(1,1); #org server certs
1137
1138   $crlcheck++;
1139   RefreshCRLs() if(($crlcheck%100) == 1);
1140
1141   #print "Sign Request X.509, Root0\n";
1142   #my $reqcontent="";
1143   #Request($ver,1,1,0,5,2,365,0,$reqcontent,"","/CN=supertest.cacert.at");
1144
1145   SysLog("NUL Request:\n");
1146   my $timestamp=strftime("%m%d%H%M%Y.%S",gmtime);
1147   Request($ver,0,0,0,0,0,0,0,$timestamp,"","");
1148   sleep(1);
1149   usleep(1700000);
1150 }