#!/s/perl/bin/perl -w

# Modify host key database in generic perl script

# $Id: Hostkey.plm,v 1.2 2005/08/23 14:48:22 thomas Exp $

=head1 NAME

CSL::Hostkey -- interface to CSL host key global files

=head1 SYNOPSIS

use CSL::Krb5;
use CSL::Hostkey;

my %opts = (
             hostkeydir => '/var/adm/hostkeys',
             lock_retry => 5,
             lock_sleep => 1,
             debug      => 1,
            );

my $hk = new CSL::hostkey (%opts);

my @updates = (
               {
                hostname => '...',
                ktype    => 'rsa1|rsa|dsa',
                key      => ...,
               },
               ...
              );

$result = $hk->updateknownhosts ( @updates );

=head1 DESCRIPTION

This module facilitates posting updates of ssh host keys to the
central host key repository.

The B<new> function creates a new hostkey object.  The options specify
the directory containing the host key files and options for the lock
file code.  No options generally need to be specified.

The B<updateknownhosts> method is passed an array of udpates.  All
attributes must have defined values, or the update is rejected.

The B<ktype> update attribute must have one of the values B<rsa1>,
B<ssh-rsa>, or B<ssh-dss> or the update will be rejected.  One call to
B<updateknownhosts> may contain updates with any mix of key types.

The method will attempt to apply some updates even if others are found
to be invalid.

=head1 RETURN VALUE

The B<new> function returns the object on success, or undef on error.

The B<updateknownhosts> function returns the number of keys updated,
or -1 on various errors.

=cut

use strict;

package CSL::Hostkey;

use FileHandle;
use Net::hostent;
use Time::localtime;

our $default_opts = {
		     hostkeydir => '/var/adm/hostkeys',
#		     hostkeydir => '/u/t/h/thomas/work/hostkeys',
		     lock_retry => 5,
		     lock_sleep => 1,
		     debug      => 1,
		    };

our $knownhostsfiles = {
			rsa1      => 'ssh_known_hosts',
			'ssh-rsa' => 'ssh_known_hosts2',
			'ssh-dss' => 'ssh_known_hosts2',
		       };

###############################################################################
# creator function

sub new {
  my $ref = shift;
  my %opts = @_;

  my $self = bless {} => ref($ref) || $ref;

  $self->{opts} = {%$default_opts};

  foreach (keys %{$self->{opts}}) {
    # Copy bits from creator object or %opts
    if (defined $opts{$_}) {
      $self->{opts}->{$_} = $opts{$_};
    } elsif (ref($ref) &&
	     exists ($ref->{opts}) &&
	     defined ($ref->{opts}->{$_})) {
      $self->{opts}->{$_} = $ref->{opts}->{$_};
    }
  }
  $self;
}


###############################################################################
# Pass an array of hashrefs.  Each hash ref is of the form:
# $data = { hostname => '',
#           ktype    => '',
#           key      => ''
#         };
#
# All parameters are required, or the update will be rejected.
# kytpe must be one of 'rsa1', 'ssh-rsa', or 'ssh-dss',
# or the update will be rejected.

sub updateknownhosts {
  my $self = shift;
  my @keys = @_;

  my ($updates, $key, $knownfile, $newfile, $oldfile, $db, $ktype, $kfile, $changes, $h);

  # Make updates & organize by final destination file
  $updates = {};
  foreach $key (@keys) {
    next unless (defined ($key->{hostname}) &&
		 defined ($key->{ktype}) &&
		 defined ($key->{key}));

    # Do gethostbyname
    next unless defined ($h = gethostbyname ($key->{hostname}));
    $key->{hostname} = $h->name;

    foreach $ktype (keys %$knownhostsfiles) {
      if ($ktype eq $key->{ktype}) {
	$updates->{$knownhostsfiles->{$ktype}}->{$key->{hostname}}->{$ktype} = $key;
	last;
      }
    }
  }

  # Now do updates
  foreach $kfile (keys %$updates) {
    $knownfile = "$self->{opts}->{hostkeydir}/$kfile";
    $newfile = "$knownfile.$$";
    $oldfile = "$knownfile.bak";

    if (!$self->filelock ($knownfile)) {
      printf STDERR "can't lock \%s\n", $knownfile;
      return 0;
    }

    $db = $self->readdb ($knownfile);
    $changes = $self->writedb ($db, $updates->{$kfile}, $newfile);

    if ($changes > 0) {
      unlink $oldfile if (-f $oldfile);
      link ($knownfile, $oldfile) if (-f $knownfile);
      rename ($newfile, $knownfile);
    }
    $self->fileunlock ($knownfile);
  }
  return $changes;
}

###############################################################################

sub filelock {
  my $self = shift;
  my $filename = shift;

  my ($fh, $i, $lockfile) = (undef, 0, $self->lockfilename ($filename));

  while ((!defined $fh) && ($i++ < $self->{opts}->{lock_retry})) {
    if (!defined ($fh = new FileHandle $lockfile, O_CREAT|O_EXCL|O_WRONLY)) {
      sleep ($self->{opts}->{lock_sleep});
    }
  }
  if (!defined $fh) {
    print STDERR "Can't get lock file $filename!\n";
    return 0;
  }
  print $fh "$$\n";
  undef $fh;
  return 1;
}

sub fileunlock {
  my $self = shift;
  my $filename = shift;

  my $lockfile = $self->lockfilename ($filename);
  if (defined $lockfile) {
    unlink ($lockfile);
  }
  return;
}

sub lockfilename {
  my $self = shift;
  my $filename = shift;

  $filename . '.lock';
}

###############################################################################

sub readdb {
  my $self = shift;
  my $knownfile = shift;

  my $db = {};
  my ($fh, @w);;

  if (!defined ($fh = new FileHandle $knownfile, 'r')) {
    printf STDERR "can't open \%s\n", $knownfile;
    $self->fileunlock ($knownfile);
    return $db;
  }
  while (<$fh>) {
    chomp;
    next if /^$/;
    next if /^\s*\#/;
    @w = split;
    if ($w[1] =~ /^(ssh-dss|ssh-rsa)$/) {
      # v2 key
      $db->{$w[0]}->{$w[1]} = $w[2];
    } else {
      # v1 key
      $db->{$w[0]}->{rsa1} = "$w[1] $w[2] $w[3]";
    }
  }
  undef ($fh);
  return $db;
}

###############################################################################

sub writedb {
  my $self = shift;
  my $db = shift;
  my $kupdates = shift;
  my $newfile = shift;

  my ($ndb, $host, $ktype, $now);
  my $changes = 0;

  # Replace any db entries with their updates
  foreach $host (keys %$kupdates) {
    foreach $ktype (keys %{$kupdates->{$host}}) {
      if (!exists ($db->{$host}) ||
	  !defined ($db->{$host}->{$ktype}) ||
	  ($db->{$host}->{$ktype} ne $kupdates->{$host}->{$ktype}->{key})) {
	$db->{$host}->{$ktype} = $kupdates->{$host}->{$ktype}->{key};
	$changes++;
	if ($self->{opts}->{debug} > 1) {
	  print STDERR "Updating $ktype key for $host\n";
	}
      }
    }
  }

  return 0 unless $changes;

  # OK...write a new file...
  if (!defined ($ndb = new FileHandle $newfile, 'w')) {
    printf STDERR "can't open \%s\n", $newfile;
    return -1;
  }
  # Print a header on the new file
  $now = ctime(time);
  print $ndb <<__Eof__
#
# this file was automatically generated by CSL::hostkey.pm
# $now
#
__Eof__
    ;

  # Write out new file
  foreach $host (sort keys %$db) {
    foreach $ktype (sort keys %{$db->{$host}}) {
      if ($ktype eq 'rsa1') {
	print $ndb "$host $db->{$host}->{$ktype}\n";
      } else {
	print $ndb "$host $ktype $db->{$host}->{$ktype}\n";
      }
    }
  }
  undef $ndb;
  return $changes;
}
