#! /usr/local/bin/perl -w
# $Id: crl-from-ldap.pl,v 1.21 2003/08/19 18:49:47 omen Exp $
# 
# This script is written and maintained by Omen Wild
# <Omen.Wild@Dartmouth.EDU>.  Feel free to email me with questions or
# concerns.
#
#
# Copyright (C) 2003 Trustees of Dartmouth College
# 
#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 2 of the License, or
#     (at your option) any later version.
# 
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.


# {{{ Uses

use strict;

use Data::Dumper;
use Getopt::Long;
use Net::LDAP;
use Pod::Usage;
use POSIX qw(strftime);
use Time::ParseDate;
use Sys::Hostname;

# }}}

# {{{ Global definitions

my $args = join(" ", @ARGV);

$ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/local/bin";
my $PROGRAM = ($0 =~ /^(.*\/){0,1}(.+)/)[1];

my $VERSION = "0.9.7";

my $host = hostname() or die "$PROGRAM: unable to get hostname: $!\n";

my $user = $ENV{LOGNAME} || $ENV{USERNAME} || $ENV{USER} || "unknown";


# }}}

# {{{ User configuration section

# ---------- Begin User Configuration Section ----------

my @apache_config_search = 
  ("/etc/apache/httpd.conf",
   "/etc/apache/conf/httpd.conf",
   "/etc/httpd/httpd.conf",
   "/etc/httpd/conf/httpd.conf",
   "/usr/local/apache/conf/httpd.conf",
  );

# Used to restart apache after updating the CRL
my $apache_init_file = "/etc/init.d/apache";

# Set (or use command line option) if autodiscovery does not work
my $crl_base;

# ---------- End User Configuration Section ----------

# }}}

# {{{ Parse command line options

my $apache_restart = 1;
my $restart_command = "";

my $previous_state = "initial";
my $delay = 1;
my $purge_old = 0;
my $verbose = 0;
my $send_email = 1;
my $email_address = "machine.room\@dartmouth.edu";
#my $email_address = "omen.wild\@dartmouth.edu";

my $test = 0;
my $test_email = "CA-Security-Officer\@Dartmouth.EDU";
#my $test_email = "omen.wild\@dartmouth.edu";

# Dartmouth LDAP defaults
my $ldap_server = "dnd.dartmouth.edu";
my $ldap_base = "O=Dartmouth College,C=US,dc=dartmouth,dc=edu";
my $ldap_filter = "cn=Dartmouth CertAuth1";

my $help = 0;
my $man = 0;

my $rc = GetOptions("apache-restart!" => \$apache_restart,
					"restart-command=s" => \$restart_command,
					"crl-base=s" => \$crl_base,
                    "ldap-server=s" => \$ldap_server,
                    "ldap-base=s" => \$ldap_base,
                    "ldap-filter=s" => \$ldap_filter,
                    "email-address=s" => \$email_address,
                    "send-email!" => \$send_email,
                    "verbose!" => \$verbose,
                    "purge-old-files!" => \$purge_old,
                    "previous-state=s" => \$previous_state,
                    "test!" => \$test,
                    "test-email=s" => \$test_email,
                    "delay=i" => \$delay,
                    "help|?" => \$help,
                    "man" => \$man,
                   );

if($help || ! $rc) {
  pod2usage(0);
}

if($man) {
  pod2usage({-exitstatus => 0, 
             -verbose => 3});
}

if($restart_command) {
  # Suppling --restart-command=foo implies an apache restart
  $apache_restart = 1;
} else {
  $restart_command = "$apache_init_file restart >/dev/null";
}

# }}}

# {{{ Pre-run checks

if (! $test) {

  if (!$crl_base) {
    # If $crl_base not set or on the command line, auto discover
  SEARCH: for my $file (@apache_config_search) {
      if (-f $file) {
        open(CONF, "<$file") or die "$PROGRAM: unable to open apache config file '$file': $!\n";
        while (my $line = <CONF>) {
          if ($line =~ m/^(\s*|#)SSLCARevocationPath\s(\S+)/) {
            if ($crl_base && $crl_base ne $2) {
              die "$PROGRAM: found multiple definitions of\nSSLCARevocationPath in '$file' that do not agree.\nPlease call with '--crl-base=dir'.\n"
            }
          
            $crl_base = $2;
          }
        }
        close(CONF);
        if ($crl_base) {
          last SEARCH;
        }
      }
    }
  
    if (!$crl_base) {
      die "$PROGRAM: unable to find CRL base directory.  Please set SSLCARevocationPath in your apache.conf, or call with '--crl-base=dir'.\n";
    }
  
    #print "$PROGRAM: autodiscovered crl-base: $crl_base\n";
  }


  chdir($crl_base) || die "$PROGRAM: unable to chdir to '$crl_base': $!\n";
  if (! -f "./Makefile" ) {
    die "$PROGRAM: expected file '$crl_base/Makefile' does not exist.\n";
  }

  #if (! -x $apache_init_file) {
  #  die "$PROGRAM: apache init file '$apache_init_file' does not exist or is not executable.\n";
  #}
}

# }}}

# {{{ Internal global definitions

my $command;

my $binary_file = "/tmp/crl.new.$$";
my $crl_file = "/tmp/dartmouth.crl.$$";

# }}}

# {{{ END cleanup

END {
  if ($binary_file && -f $binary_file) {
    unlink($binary_file);
  }
  
  if ($crl_file && -f $crl_file) {
    unlink($crl_file);
  }
}

# }}}

# {{{ LDAP

my $ldap = Net::LDAP->new($ldap_server) or die "$PROGRAM: $@";

my $mesg = $ldap->bind(version => 3);

my $result = $ldap->search (
                            base    => $ldap_base,
                            scope   => "sub",
                            filter  => "($ldap_filter)",
                            attrs   =>  ["certificaterevocationlist;binary"],
                       );

my $href = $result->as_struct;

my %hash = %$href;

#print Dumper(\%hash);

my $crl = "";

foreach my $key (keys(%hash)) {
  if(defined($hash{$key}{'certificaterevocationlist;binary'})) {
    if($crl ne "") {
      die "$PROGRAM: 'certificaterevocationlist;binary' defined more than once for:\n$ldap_server '$ldap_base' '$ldap_filter'\n";
    }
    $crl = join("", @{$hash{$key}{'certificaterevocationlist;binary'}});
  }
}

$ldap->unbind;

if (! $crl) {
  die "$PROGRAM: unable to find 'certificaterevocationlist;binary' field in ldap data.\n";
}

# }}}

# {{{ Write LDAP output to file

open(OUT, ">$binary_file") or die "$PROGRAM: unable to open output file '$binary_file': $!\n";

print OUT $crl;

close(OUT);

if ( ! -f $binary_file || -z $binary_file) {
  die "$PROGRAM: output file '$binary_file' does not exist or is empty.";
}

# }}}

# {{{ Work with CRL dates: lastupdate

$command = "openssl crl -noout -inform DER -lastupdate -in $binary_file";
my $lastupdate = `$command`;

if($lastupdate =~ m/^lastUpdate=(.*)$/) {
  #my $seconds_since_jan1_1970 = parsedate($1);
  #my $lastupdate_str = strftime("%Y-%m-%d.%T", localtime($seconds_since_jan1_1970));
} else {
  die "$PROGRAM: unable to extract a last updated field from '$binary_file'\n$command\n";
}

# }}}

# {{{ If requested, test to see if the CRL is > 24 hours old, or expired

if ($test) {
  if ($lastupdate =~ m/^lastUpdate=(.*)$/) {
    my $seconds_since_jan1_1970 = parsedate($1);
    my $seconds_old = time() - $seconds_since_jan1_1970;
    my $hours = sprintf("%.2f", $seconds_old / (60 * 60));
    if ($hours > 24) {
      print "$PROGRAM: warning, the CRL is > 24 hours old ($hours hours).\n";

      # Last update was more than 24 hours ago, complain to Kevin
      open(SENDMAIL, "|/usr/lib/sendmail -oi -t -odq") or die "$PROGRAM: unable to open a pipe to sendmail: $!\n";

      print SENDMAIL <<EOF;
From: $user\@$host
To: $test_email
Subject: WARNING: LDAP CRL more than 24 hours old ($host)

WARNING: the host $host retrieved a CRL from the LDAP that is more
than 24 hours old (currently $hours hours old).  This indicates the CRL is
not getting properly published to LDAP.

LDAP info:
Server: $ldap_server
Base  : $ldap_base
Filter: $ldap_filter

EOF
      
      close(SENDMAIL) or die "$PROGRAM: error closing sendmail pipe: $!\n";
    }
  } else {
	# Expired
  }
  
  exit;
}

# }}}

# {{{ Work with CRL dates: nextupdate

$command = "openssl crl -noout -inform DER -nextupdate -in $binary_file";
my $nextupdate = `$command`;

if ($nextupdate && $nextupdate =~ m/^nextUpdate=(.*)$/) {
  if ($1 eq "NONE") {
    $nextupdate = "NoExpiration";
  } else {
    my $seconds_since_jan1_1970 = parsedate($1);
    #print "DEBUG: $1 seconds_since_jan1_1970: $seconds_since_jan1_1970:\n";
    $nextupdate = strftime("%Y-%m-%d.%T", localtime($seconds_since_jan1_1970));

    # ??? DEBUG: change to > for debugging, < for production
    if ($seconds_since_jan1_1970 < time()) {
      if ($previous_state eq "initial") {
        warn <<EOW;
$PROGRAM: WARNING, the validity of the new CRL expired at $nextupdate.
This means Apache will not accept any client certificates until the
CRL is updated in LDAP.  This program will auto-reschedule itself until
condition clears up.

Please contact machine.room\@dartmouth.edu if the condition does not
clear up.

LDAP info:
Server: $ldap_server
Base  : $ldap_base
Filter: $ldap_filter
EOW
      }

      $command = "echo ";
      if ($0 =~ m/^\//) {
        $command .= "$0 ";
      } else {
        $command .= $ENV{PWD} . "/$0 ";
      }

      $delay = $delay * 2;
      $command .= "$args --crl-base=$crl_base --previous-state=failed-date --delay=$delay --nosend-email | at now + $delay minutes 2>/dev/null";
      print "Rescheduling command:\n$command\n";
      $rc = system($command);
      if ($rc != 0) {
        warn "\n$PROGRAM: ERROR rescheduling run of $0, please run by hand:\n$command\n";
      }
    
      if ($send_email) {
        send_email();
      }

      exit(1);
    }
  }
} else {
  die "$PROGRAM: unable to extract a next updated field from '$binary_file'\n$command\n";
}

if($previous_state eq "failed-date") {
  warn <<EOW;
$PROGRAM: error condition cleared up, the CRL should now be up to
date.  If this happens often, or lasts for a long time, please report
this to CA-Security-Officer\@Dartmouth.EDU .
EOW
}

# }}}

# {{{ Convert binary data to an Apache CRL

if (-f $crl_file) {
  unlink($crl_file);
}

$command = "openssl crl -text -inform DER -in $binary_file > $crl_file";
$rc = system($command);
if ($rc != 0) {
  die "$PROGRAM: error executing\n$command\n$!\n";
}

# }}}

# {{{ Deal with existing CRLs

my $final_file = "$crl_base/Dartmouth-LDAP-$nextupdate.crl";

if (-f $final_file) {
  $rc = system("mv $final_file $final_file.old");
  if ($rc != 0) {
    die "$PROGRAM: error moving '$final_file' to '$final_file.old': $!\n";
  } 
}

# }}}

# {{{ Move new CRL into final location

$command = "mv $crl_file $final_file";
$rc = system($command);
if ($rc != 0) {
  die "$PROGRAM: error running: $!\n$command\n";
} 

chmod(0444, $final_file);

# }}}

# {{{ (re)move old auto-generated crls

{
 my $hash = `openssl crl -noout -hash < $final_file`;
 chomp($hash);
 
 opendir(DIR, $crl_base);
 
 my @old = grep { /^Dartmouth-LDAP-[-0-9:\.]+\.crl$/ && -f "$_" &&
                    ! /^Dartmouth-LDAP-$nextupdate.crl$/ } readdir(DIR);
 
 closedir(DIR);
 
 #print "old: ", join(" ", @old), "\n";
 for my $old (@old) {
   if ($purge_old) {
     if($verbose) {
       print "$PROGRAM: removing old CRL: $old\n";
     }
     unlink($old) or die "$PROGRAM: unable to unlink '$crl_base/$old'\n";
    } else {
      my $i = 1;
      while (-e "${old}.$i") {
        $i++;
      }
      $command = "mv '$old' '${old}.$i'";
      $rc = system($command);
      if ($rc != 0) {
        die "$PROGRAM: error running:\n$command\n";
      } 
    }
 }
}

# }}}

# {{{ Get Apache up to date

$command = "make update >/dev/null";
$rc = system($command);
if ($rc != 0) {
  die "$PROGRAM: error running '$command' in '$crl_base'.\n";
}

# Restarting apache may not be necessary to make it reread the CRL
if ($apache_restart) {
  $rc = system($restart_command);
  if ($rc != 0) {
	die "$PROGRAM: error restarting apache: $!\n!!! WARNING !!! This probably means apache is no longer running on $host !!! WARNING !!!";
  }
}

# }}}

# {{{ sub send_email

sub send_email {
  open(SENDMAIL, "|/usr/lib/sendmail -oi -t -odq") or die "$PROGRAM: unable to open a pipe to sendmail: $!\n";

  print SENDMAIL <<"EOF";
From: $user\@$host
To: $email_address
Subject: ERROR: LDAP CRL expired ($host)

ERROR, the host $host retrieved a CRL from the LDAP that is out of
date.  Please contact $user\@$host to see if this error clears up
within a reasonable time.  If it does not, or many machines report
this error, please contact CA-Security-Officer\@Dartmouth.edu .

This error will prevent anyone from contacting the webserver on $host
using https.

LDAP info:
Server: $ldap_server
Base  : $ldap_base
Filter: $ldap_filter

EOF
      
  close(SENDMAIL) or die "$PROGRAM: error closing sendmail pipe: $!\n";
      
}

# }}}

# {{{ Pod Docs

__END__

=head1 NAME

crl-from-ldap.pl - Retrieve a CRL from a LDAP server and stuff it into Apache

=head1 SYNOPSIS

crl-from-ldap.pl [options]

 Options:
   --[no]apache-restart
   --restart-apache="command"

   --crl-base=directory
   --email-address=address

   --ldap-server=string
   --ldap-base=string
   --ldap-filter=string

   --[no]purge-old-files
   --[no]send-email
   --[no]verbose

   --[no]test
   --test-email=address

   --previous-state=string (internal use only)
   --delay=integer (internal use only)

   --help | -? | --?
   --man | -m

=head1 OPTIONS

=over 8

=item B<--[no]apache-restart>

Default: restart Apache

Controls the restarting of Apache after the CRL is updated.  This
I<may> not be necessary, but it is safer to restart Apache.

=item B<--restart-apache="command">

Default: /etc/init.d/apache restart >/dev/null

If you want to restart apache, but do not want to use the default,
then specify the exact command here.

Setting this options implies B<--apache-restart>.

The most useful alternative to the default is: /usr/sbin/apachectl graceful > /dev/null

=item B<--crl-base=directory>

Default: auto-discover

This sets the base directory to use for placement of the CRL.  Set
this if you have more than one Apache instance installed on a machine,
or the auto-discover feature does not work.

=item B<--email-address=address>

Default: machine.room@dartmouth.edu

Where to send an email if the CRL in the LDAP has expired.

=item B<--ldap-server=string>

Default: dnd.dartmouth.edu

What server the LDAP database resides on.

=item B<--ldap-base=string>

Default: "O=Dartmouth College,C=US,dc=dartmouth,dc=edu"

The LDAP base name.

=item B<--ldap-filter=string>

Default: "cn=Dartmouth CertAuth1"

The name of the object that holds the certificate.

=item B<--[no]purge-old-files>

Default: no

Purge the old CRLs pulled from LDAP.  The default is to rename them.

=item B<--[no]send-email>

Default: yes

Send an email to the I<--email-address> when the CRL in the LDAP has
expired.  This event should not happen, and when it does it is a
serious problem.  See the DESCRIPTION section for why.

=item B<--[no]verbose>

Default: no

Print extra information to STDOUT.

=item B<--[no]test>

Default: no

Test the CRL in LDAP to make sure it is not older than 24 hours.  Send
an email to B<--test-email> if necessary.

This does NOT perform an update of the CRL for Apache.

=item B<--test-email=addresss>

Default: CA-Security-Officer@Dartmouth.EDU

The email address to send a warning to if the 24 hour test selected by
B<--test> fails.

=item B<previous-state=string (internal)>

For internal use only.

=item B<delay=integer (internal)>

For internal use only.

=item B<--help | --? | -?>

A quick list of options.

=item B<--man | -m>

The full POD documentation.

=head1 DESCRIPTION

B<crl-from-ldap.pl> retrieves a CRL (Certificate Revocation List) from
the Dartmouth LDAP server and puts it where Apache/modssl can find it.
This version requires the Apache directive I<SSLCARevocationPath> to
be set.  It will check several known locations looking for the Apache
configuration file.  If auto-discovery does not work, then call this
program with the command line argument --crl-base=directory .

If any sort of error occurs this program aborts, printing the error
(if you run it under cron, the error will be mailed to the owner of
the crontab).  If the CRL retrieved from LDAP has an expiration date
in the past this program prints a warning and sends an email to the
Dartmouth Machine Room Operators.  It then keeps trying to retrieve
the CRL until it succeeds, sleeping an increasing number of minutes
between each attempt.

This program is intended to be run from a crontab, scheduled to run
once a day.  It needs to run as a user that has write permissions to
Apache's CRL directory (usually root).  If the CRL that Apache is
using has expired, Apache will refuse to serve any pages to Client
Certificate protected pages until the CRL is removed or updated.  Thus
it is critical to watch for errors from the retrieval script.

In addition to the regularly scheduled CRL publication, a new CRL is
generated when a Certificate is revoked.  It would also be wise to run
this script on a regular schedule (usually daily) to catch any
certificates that are revoked between regularly scheduled updates.
More frequent updates are possible but not recommended.  If your
application requires realtime checking it should implement OCSP
internally.

In addition, this program can function to test the validity date of
the CRL in LADP (through the B<--test> option).  Dartmouth's normal CRL
publication schedule is intended to ensure that a CRL is published at
least every 24 hours.  This setting will send an error to the
operator of the CA in case the publication fails for any reason.

=head1 CRON

The retrieval script can be run daily at 10am by putting the following
line into root's crontab:

0 10 * * * /path/to/script/crl-from-ldap.pl

If you have multiple Apache instances running on a single machine,
then you will need to run this script multiple times, passing the CRL
base directory for each Apache using the B<--crl-base=directory>
argument.

=head1 Perl Requirements

The retrieval script requires the following Perl modules:
Data::Dumper, Getopt::Long, Net::LDAP, Pod::Usage, POSIX,
Time::ParseDate, and Sys::Hostname .

If these modules are not installed they can be retrieved from
http://www.cpan.org .

=head1 AUTHOR/BUGS

This script was written and is maintained by Omen Wild
I<Omen.Wild@Dartmouth.EDU>.  Feel free to email with questions or
concerns.

=head1 COPYRIGHT

Copyright (C) 2003 Trustees of Dartmouth College.  

This is free software; see the source for copying conditions.  There
is NO war- ranty; not even for MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.


=cut

# }}}