#!/usr/bin/perl

# $Id: exporter 1043 2007-12-19 21:52:34Z jhealy $

=head1 NAME

  exporter

=head1 SYNOPSIS

  exporter [dns] [dhcp] [tftp] [cups] <datafile> <output_dir>

=head1 ABSTRACT

Given a data file of printer information, this script autogenerates
files for other services that printing depends upon.

=head1 DESCRIPTION

This script autogenerates configuration files for services that work
with printing.  This includes:

=over 4

=item DNS

We use DNS-SD (aka "Zeroconf" or "Bonjour") to automate the discovery
of services on the network, including printers.  This script will
generate DNS zone information to advertise printers.

=item DHCP

We configure printers on the network using DHCP.  This script will
generate DHCP host statements (for ISC's DHCP server) that will
configure and identify printers on the network.  If TFTP
configurations are being used (see below), those will be added to the
host statements as well.

=item TFTP Printer Configurations

HP printers can be configured via DHCP by downloading their
configuration from a TFTP server.  This script will create
configuration files with a base level of settings applied.

=item CUPS

For clients that don't support DNS-SD (e.g., Mac OS X clients before
10.4), we provide a script that users can run that will manually add
the printers to the system.  This script will generate a script that
will add printers to the local system.


=back


=head2 DATA FILE FORMAT

To generate all the necessary information, we need a data file that
provides everything we need.  The input data file is simply a valid
Perl file containing a hash of all the values we need to generate all
the other files.

The file must contain a single hash called PRINTERS.  Each entry in
this hash should consist of the "friendly" name for the printer,
associated with anonymous hash of all the values for the printer.
Here's a sample of the global hash with a single entry listing each of
the possible keys in the inner hash:

  %PRINTERS = (

    # "Friendly" name of printer (shown to end users)
    "Multimedia Lab" => {

      # printer's hardware ethernet address
      macaddr => "de:ad:be:ef:f0:0d",

      # hostname to assign to the printer (optional, can be auto-generated)
      hostname => "printer-multimedia-lab-hplj4100n",

      # physical location of the printer
      location => "",

      # Type of printer; shown to user and used to auto-generate other values
      type => "HPLJ 4100n",

      # Model of printer from PPD file (use "*Product" line)
      # used to allow auto-selection of PPD by clients
      product => "(HP LaserJet 4100 Series )",

      # Boolean: is printer accessible via HTTP for configuration?
      web => 1,

      # Boolean: Does printer accept jobs via IPP?
      ipp => 1,

      # Boolean: Does printer accept jobs via LPR?
      lpd => 1,

      # MIME types (comma-separated) that the printer accepts on it's custom
      # port (e.g., PCL).  If undefined, assume that only LPR/IPP should be
      # advertised
      pdl => "application/vnd.hp-PCL",

      # Does the printer support duplex printing?
      duplex => "F",

      # Does the printer support color printing?
      color => "T",

      # Extra key/value pairs to insert into DNS-SD TXT record (optional)
      dnssdtxt => {}
    }
  );


=cut


# Be strict about syntax
use warnings;
use strict;

# Master hash of printer data (will be populated from file on disk)
my %PRINTERS = ();

# Domain to add to unqualified names
my $DOMAIN = "gear.suffieldacademy.org";

# Network Administrator contact info
my $NETADMIN = 'Network Administrator (netadmin@suffieldacademy.org)';

# Printer contact info
my $PRINTER_ADMIN = 'CRC Help Desk';
my $PRINTER_PHONE = 'x4420';

# Default password for printers
my $PASSWORD = 'leonard';


if ($#ARGV < 1) {
  print "Usage:\n";
  print "\texporter [dns] [dhcp] [tftp] [cups] <datafile> <output_dir>\n\n";
  exit 1;
}

# Sanity check on output dir
my $output = pop(@ARGV);
if ( -e $output ) {
  die "Output directory already exists; please move it out of the way\n";
}
else {
  mkdir "$output" or die "Couldn't create output dir '$output': $!\n";
}

# Read in the specified data file
my $datafile = pop(@ARGV);
open (PRINTERS, $datafile) or die "Could not open printer data file: $!\n";
eval join("", <PRINTERS>);
close(PRINTERS);



=head2 lint($string) [returns I<string>]

Given a string containg a printer name and/or model number, convert it
into a DNS- and filesystem-safe string (no spaces, all lower-case,
etc).

=cut
sub lint($;) {

  my $name = shift(@_);

  # convert to all lower case
  $name =~ tr /A-Z/a-z/;

  # convert spaces and underscores to dashes
  $name =~ s/\s+/-/g;
  $name =~ s/_+/-/g;

  # pave everything else
  $name =~ s/[^a-z0-9-]//g;

  return $name;

} # end sub lint


=head2 hostname($printer) [returns I<string>]

Given a single printer table, this method looks up or auto-generates the
hostname for the printer.  The auto-generated value is only created if an
explicit value is not provided, and is built from the name and model of the
printer.

=cut
sub hostname($;) {

  my $printer = shift(@_);
  my %table = %{$PRINTERS{$printer}};

  if (defined($table{hostname})) {
    return $table{hostname};
  }

  # otherwise, fall back to auto-generation
  my $hostname = join("-", ("printer", $printer, $table{type}));

  # convert to DNS-friendly format
  $hostname = lint($hostname);

  # store the new hostname for quicker access next time
  $PRINTERS{$printer}->{hostname} = $hostname;

  return $hostname;

} # end sub hostname


my %PPD_PRODUCTS = ();

=head2 hashPPDs() [returns I<boolean>]

Searches through all PPD files to build a hash of PPD -> product information.
This allows us to easily find the PPD that goes with a particular model.

=cut
sub hashPPDs() {

  foreach my $ppd (glob("cups-ppds/*.ppd")) {
    open (PPD, $ppd) or warn "Could not open PPD file '$ppd': $!\n";
    while (defined(my $line = <PPD>)) {
      if ($line =~ /^\*Product:\s*"([^\"]+)"/) {
	my $model = $1;
	$PPD_PRODUCTS{$1} = $ppd;
	last;
      }
    }
    close(PPD);
  }

} # end sub hashPPDs


=head2 findPPD($printer) [returns I<string>]

Given a single printer table, this method finds the corresponding PPD
file for the given model of printer.

=cut
sub findPPD($) {

  my $printer = shift(@_);
  my %table = %{$PRINTERS{$printer}};

  # populate PPD hash, if necessary
  if (keys %PPD_PRODUCTS == 0) {
    hashPPDs();
  }

  if (defined($PPD_PRODUCTS{$table{product}})) {
    return $PPD_PRODUCTS{$table{product}};
  }
  # fall back to generic PPD
  elsif (defined($PPD_PRODUCTS{"(PostScript Printer)"})) {
    return $PPD_PRODUCTS{"(PostScript Printer)"};
  }
  else {
    warn "Unable to find PPD for $printer\n";
    return "";
  }

} # end sub findPPD


=head2 getTFTPTemplate($printer) [returns I<string>]

Given a single printer table, this method finds the corresponding TFTP
configuration file template.  It does this by first searching for a
template that matches the printer's name, and then falls back to
finding it based on the printer's model.

The template file is read into memory and returned as a string, ready to be
eval()-ed.

=cut
sub getTFTPTemplate($;) {

  my $printer = shift(@_);
  my %table = %{$PRINTERS{$printer}};

  my $file = "tftp-templates/" . hostname($printer);

  # first, look for host-specific config
  if (! -f $file) {
    # next, try by model
    $file = "tftp-templates/" . lint($table{type});

    if (! -f $file) {
      warn "No config template available for $printer\n";
      return undef;
    }
  }

  # now, read in the file, and add eval wrapper info
  my $template = '$tftpConfig = << "ENDTFTPCONFIGTEMPLATE"' . "\n";

  open (TEMPLATE, $file)
    or die "Could not open tftp template file '$file': $!\n";
  $template .= join("", <TEMPLATE>);
  close(TEMPLATE);

  $template .= "\nENDTFTPCONFIGTEMPLATE\n";

  return $template;

} # end sub getTFTPTemplate


=head2 dnsCharEscape($string) [returns I<string>]

Given a string, this method escapes it so it only contains valid ASCII
letters and digits.  All other characters are converted to decimal
escapes, as per the RFC.

=cut
sub dnsCharEscape($;) {

  my $str = shift(@_);

  # split the string into chars
  my @chars = split("", $str);

  # convert all non-alphanumerics to decimal escapes
  foreach my $i (0 .. $#chars) {
    if ($chars[$i] =~ /[^a-zA-Z0-9_-]/) {
      $chars[$i] = "\\" . sprintf("%03u", ord($chars[$i]));
    }
  }

  # recombine chars into string
  $str = join("", @chars);

  return $str;

} # end sub dnsCharEscape


=head2 dnsQuoteEscape($string) [returns I<string>]

Given a string, this method escapes all double-quote characters (") so
they are valid to include in a DNS TXT record deliniated by double
quotes.

=cut
sub dnsQuoteEscape($;) {

  my $str = shift(@_);

  # escape all quotes
  $str =~ s/"/\\"/g; # " <- syntax-highlight fix

  return $str;

} # end sub dnsQuoteEscape


=head2 dnsTxtHash(I<$printer>, [I<%extra>]) [returns I<string>]

Converts the properties of a printer into a string-based key/value
format suitable for insertion into a DNS TXT record BIND entry.

Additionally, an optional hash with additional key/value pairs may be
specified.  Any key/value pairs in this hash will overwrite defaults or ones
specified in the printer record.

=cut
sub dnsTxtHash($;$) {

  my $printer = shift(@_);
  my $extraref = shift(@_);

  my %table = %{$PRINTERS{$printer}};

  my %output = ();

  $output{product} = dnsQuoteEscape($table{product});
  $output{note}    = dnsQuoteEscape($table{location});
  $output{ty}      = dnsQuoteEscape($table{type});
  $output{Duplex}  = dnsQuoteEscape($table{duplex});
  $output{Color}   = dnsQuoteEscape($table{color});

  if (defined($table{web}) && $table{web} == 1) {
    $output{adminurl} = "http://" . dnsQuoteEscape(hostname($printer)) .
               ".$DOMAIN/";
  }

  my %dnssd = %{$table{dnssdtxt}};

  # tack on all the extra keys
  foreach my $k (keys %dnssd) {
    $output{$k} = dnsQuoteEscape($dnssd{$k});
  }

  my %extra = ();

  if (defined($extraref)) {
    %extra = %{$extraref};
  }

  # tack on all the extra keys
  foreach my $k (keys %extra) {
    $output{$k} = dnsQuoteEscape($extra{$k});
  }


  # convert hash to a string
  my $output = qq{"txtvers=1"\n};
  foreach my $key (sort keys %output) {
    $output .= qq{"$key=$output{$key}"\n};
  }

  return $output;

} # end sub dnsTxtHash


=head2 configDNS() [returns I<boolean>]

Generates a single DNS zone file fragment for all printers.  Note that this
is not a complete zone file; it must be added to an existing file with SOA
header and other information.

Returns a non-zero value if an error occurs.

=cut
sub configDNS() {

  open(DNS, '>', ($output . "/dns-zone.inc"))
    or warn "Could not create DNS config file: $!\n";

  foreach my $printer (sort keys %PRINTERS) {

    my %table = %{$PRINTERS{$printer}};

    # convert "friendly" name into DNS-ready entries
    my $name = dnsCharEscape($printer);
    my $host = hostname($printer);

    my $sdTxt = qq{"txtvers=1"\n};

    print DNS "\n\n;; $printer ($host)\n\n";

    # assume LPR is enabled
    unless (defined($table{lpr}) && $table{lpr} == 0) {
      $sdTxt = dnsTxtHash($printer, {"priority" => "30"});
      print DNS << "EOLPR";
; LPR service for $printer
_printer._tcp IN PTR $name._printer._tcp
$name._printer._tcp IN SRV 0 0 515 $host.$DOMAIN.
$name._printer._tcp IN TXT (
$sdTxt)

EOLPR
    }
    if (defined($table{ipp}) && $table{ipp} == 1) {
      $sdTxt = dnsTxtHash($printer, {"priority" => "20"});
      print DNS << "EOIPP";
; IPP service for $printer
_ipp._tcp IN PTR $name._ipp._tcp
$name._ipp._tcp IN SRV 0 0 631 $host.$DOMAIN.
$name._ipp._tcp IN TXT (
$sdTxt)

EOIPP
    }
    if (defined($table{pdl})) {
      $sdTxt = dnsTxtHash($printer, {"priority" => "10", "pdl" => $table{pdl}});
      print DNS << "EOPDL";
; PDL service for $printer
_pdl-datastream._tcp IN PTR $name._pdl-datastream._tcp
$name._pdl-datastream._tcp IN SRV 0 0 9100 $host.$DOMAIN.
$name._pdl-datastream._tcp IN TXT (
$sdTxt)

EOPDL
    }

  }

  close(DNS);

  return 0;

} # end sub configDNS


=head2 configDHCP() [returns I<boolean>]

Generates a single ISC DHCP configuration file fragment.  The fragment
will contain several "host" statements, one for each printer.  Note
that the fragment is not a valid configuration file; it must be part
of a full configuration (the "include" statement may be helpful for
this).

Returns a non-zero value if an error occurs.

=cut
sub configDHCP() {

  open(DHCP, '>', ($output . "/clients_gear_printers.inc"))
    or warn "Could not create DHCP config file: $!\n";

  print DHCP << "EODHCPHEAD";
# DHCP Host entries for Suffield Printers
#
# This config file is AUTOGENERATED.  DO NOT EDIT BY HAND!
#
#
# \$Id: \$
#
# See http://web.suffieldacademy.org/ils/netadmin/docs/printing/

EODHCPHEAD

  foreach my $printer (sort keys %PRINTERS) {

    my %table = %{$PRINTERS{$printer}};
    my $host = hostname($printer);

    # name configs by MAC Address to keep names short (too long and they
    # won't fit in the DHCP response)
    my $macaddr = $table{macaddr};
    $macaddr =~ s/[^0-9a-fA-F]//g;

  print DHCP << "EODHCP";

# $printer
host $host {
    hardware ethernet $table{macaddr};
    fixed-address $host.$DOMAIN;
#    ddns-hostname "$host";
EODHCP

  if ( -e "$output/tftp/$macaddr" ) {
    print DHCP qq{    option jd-tftp-config "/private/tftpboot/printers/$macaddr";\n};
  }

  print DHCP "}\n";

  }

  close(DHCP);

  return 0;

} # end sub configDHCP


=head2 configTFTP() [returns I<boolean>]

Creates a directory of plain text files suitable for configuring
printers when loaded via TFTP.  Each file will be named based on the
hostname of the printer.

Returns a non-zero value if an error occurs.

=cut
sub configTFTP() {

  mkdir "$output/tftp" or return "Could not create TFTP output dir: $!";

  foreach my $printer (sort keys %PRINTERS) {
    my $tftpConfig = "";

    # generate hostname and add it to table
    hostname($printer);

    my %table = %{$PRINTERS{$printer}};

    # name configs by MAC Address to keep names short (too long and they
    # won't fit in the DHCP response)
    my $macaddr = $table{macaddr};
    $macaddr =~ s/[^0-9a-fA-F]//g;

    my $template = getTFTPTemplate($printer);

    if (defined($template)) {
      open(TFTP, '>', "$output/tftp/$macaddr")
	or warn "Could not create TFTP config for $printer: $!\n";

      eval $template;

      print TFTP $tftpConfig;

      close(TFTP);
    }
    else {
      print "Skipping TFTP generation for $printer (no template available)\n";
    }
  }

  return 0;

} # end sub configTFTP


=head2 configCUPS() [returns I<boolean>]

Creates a Bash shell script that, when run, will configure and add each
printer to the current system.

Returns a non-zero value if an error occurs.

=cut
sub configCUPS() {

  open(CUPS, '>', "$output/cups_installer")
    or warn "Could not create CUPS installer script file: $!\n";

  # write out the header for the installer script
  print CUPS << "CUPSHEADER";
#!/bin/bash

#
# cups_installer
#
# This script is intended to be run from an Apple Mac OS X Installer package.
#
# This script is AUTOGENERATED, please see the following for information:
# http://web.suffieldacademy.org/ils/netadmin/docs/software/printing/
#
# This program installs the listed printers onto a CUPS-aware Mac OS X
# system.  Errors and warnings are printed to STDOUT.
#

# Set relative root for testing, or package root for production
ROOT=`dirname "\${0}"`
if [ -n "\${1}" ]; then
    ROOT="\${1}/Contents/Resources"
fi

echo "Deleting all Suffield printers before re-adding:"
for printer in `lpstat -a | grep '^Suffield_' | awk '{print \$1}'`; do
    echo "    Deleting \$printer"
    lpadmin -x "\$printer" -E >/dev/null 2>&1
done

CUPSHEADER

  foreach my $printer (sort keys %PRINTERS) {

    my %table = %{$PRINTERS{$printer}};
    my $host = hostname($printer);

    my $ppd = findPPD($printer);
    my $name = "Suffield_" . $host;
    my $uri = "";

    if (defined($table{ipp}) && $table{ipp} == 1) {
      $uri = "ipp://$host.$DOMAIN/ipp/";
    }
    else {
      $uri = "lpd://$host.$DOMAIN/";
    }

  print CUPS << "CUPSPRINTER";

# $printer
echo "Adding $name at $uri with PPD $ppd"
lpadmin -p "$name" -E \\
    -v "$uri" \\
    -P "\$ROOT/$ppd" \\
    -L "$table{location}" \\
    -D "$printer"
CUPSPRINTER

  }

  print CUPS "\n\nexit 0\n";

  close(CUPS);

  chmod(0755, "$output/cups_installer");

  return 0;

} # end sub configCUPS



############################################################################
###                            MAIN                                      ###
############################################################################

# Now, dispatch with the rest of the arguments

foreach my $arg (@ARGV) {

  my $result = 0;

  if ($arg eq 'dns') {
    $result = configDNS();
  }
  elsif ($arg eq 'dhcp') {
    $result = configDHCP();
  }
  elsif ($arg eq 'tftp') {
    $result = configTFTP();
  }
  elsif ($arg eq 'cups') {
    $result = configCUPS();
  }
  else {
    $result = 1;
  }

  if ($result != 0) {
    warn "Errors while processing $arg\n";
  }

}


=head1 SEE ALSO

Full documentation for this package is located on the web:

L<http://web.suffieldacademy.org/ils/netadmin/docs/software/printing/>

=head1 AUTHOR

Jason Healy, Suffield Academy

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Jason Healy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut