#!/usr/bin/perl

# $Id: exporter 2424 2015-10-21 18:22:27Z jhealy $

=head1 NAME

  exporter

=head1 SYNOPSIS

  exporter [dns] [dhcp] [tftp] [sql] <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 SQL

Creates SQL insert/update statements to add printer MAC addresses
to our home-grown NAC (puts them into the correct VLAN)

=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" => {

      # Every printer instance must be "provided" by a physcial machine
      # with a hostname.  Most printers have exactly one provider, but
      # it is possible to set up redundant print instances that have
      # multiple printers advertised under the same name.
      #
      # This "providers" key defines an array of hashrefs, each of which
      # defines the host properties for a physical printer that
      # provides this print service.
      #
      # The "macaddr" key MUST be present.
      # The "fqdn" keys MUST be present, UNLESS there is only a single
      # provider for this printer (in which case it MAY be present, but
      # an autogenerated value will be used if it is not).
      # The "priority" and "weight" keys MAY be present.  All are described
      # in more detail below.
      providers => [
        {
          # Printer's hardware ethernet address.  Required for all providers.
          macaddr => "de:ad:ba:be:fa:ce",

          # hostname to assign to the printer (optional when there is only
          # a single provider for a printer).  This key should only be used
          # for multiple providers, or when the DNS name for a printer
          # has already been established and needs to be forced to a
          # particular value
          fqdn => "multimedia-lab-red.suffieldacademy.org",

          # For multiple providers, you can also specify a priority (like
          # for MX records) and weight (to distinguish items with the same
          # priority).  Using both is likely overkill unless you have a
          # LOT of printers doing the same job.
          #
          # "priority" is for selection of classes of service (lower numbers
          # are preferred).
          # "weight" is to assist the random selection of hosts with the
          # same priority.
          #
          # Therefore, use "priority" for failover (use one before another)
          # and "weight" for load-balancing (distribute within a priority).
          priority => 0, # lower numbers get preference
          weight => 0, # higher numbers get preference
        },
        {
          # Note that this FQDN is required as it's a multi-provider example
          fqdn => "multimedia-lab-blue.suffieldacademy.org",
          macaddr => "de:ad:fa:ce:b0:0c",
          priority => 20 # only use if primary is down
        }
      ]


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

      # Type of printer; shown to user and used to auto-generate other values;
      # should match "Model" PPD key
      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 )",

      # Hash defining standard keys to be advertised for all available
      # services.  Key names should match those published in the Bonjour
      # printing spec.  If a key should only exist for a particular service,
      # use one of the service-specific hashes below.
      default => {
        # commonly-defined keys:
        duplex => "T",
        color => "F",
        # slightly less-commonly-defined:
        Binary => "T",
        Transparent => "T"
        # more esoteric:
        TBCP => "T",
        Copies => "T",
        Collate => "T",
        Fax => "F",
        Scan => "T"
      },

      # Hash.  If defined, printer is accessible for configuration via HTTP.
      web => {},

      # Hash.  If defined, printer is accessible via LPD.  Keys/vals are
      # same as for "default" hash above, and override values found there.
      lpd => {},

      # Hash.  If defined, printer is accessible via IPP.  Keys/vals are
      # same as for "default" hash above, and override values found there.
      ipp => {},

      # Hash.  If defined, printer is accessible via direct socket
      # printing.  Keys/vals are same as for "default" hash above, and
      # override values found there.
      socket => {
        # MIME types (comma-separated) that the printer accepts on it's custom
        # port (e.g., PCL).  Should always be specified for socket.
        pdl => "application/vnd.hp-PCL",
      }
    }
  );


=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 = "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 = 'x4471';

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

# output directory for generated files (will be set via command-line args)
my $OUTPUT = undef;

# Services that each printer can offer.  The keys are the same as those
# used in the %PRINTERS hash, and the values are the actual DNS
# service-to-domain mapping names when we output DNS
my %SERVICES = (
	     'lpd' => '_printer._tcp',
	     'ipp' => '_ipp._tcp',
	     'socket' => '_pdl-datastream._tcp',
	     'web' => '_http._tcp,_printer._tcp'
	    );

# Ports that go with each service
my %PORTS = (
	     'lpd' => 515,
	     'ipp' => 631,
	     'socket' => 9100,
	     'web' => 80
	    );


=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 genhostname($printer) [returns I<void>]

Given a single printer instance key, this method auto-generates the
hostname for the first provider of this printer.  For single-provider
printers, this works well.  If you have multiple providers, you'll probably
want to set the FQDN explicitly for each one so they don't conflict.

The auto-generated name is built from the name and model of the printer.

=cut
sub genhostname($;) {

  my $printer = shift(@_);

  my $provider = $PRINTERS{$printer}{providers}->[0];
  if ($PRINTERS{$printer}{providers}->[1]) {
    warn "$printer has more than one provider; autogenerating hostnames is not recommended!\n";
  }

  if (defined($provider->{fqdn}) && $provider->{fqdn} =~ /^([^.]+)\./) {
    return;
  }

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

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

  # store the new hostname for quicker access next time
  $provider->{fqdn} = $hostname . '.' . $DOMAIN;

} # end sub genhostname


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

Given a single printer and provider, 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 $provider = shift(@_);

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

  (my $host) = ($provider->{fqdn} =~ /^([^.]+)/);
  my $file = "tftp-templates/$host";

  # 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
  for 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 key referencing a hash with additional key/value
pairs may be specified.  Any key/value pairs in this hash will overwrite
defaults or ones.  Names would be 'lpd', 'ipp', or 'socket'.

=cut
sub dnsTxtHash($;$) {

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

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

  my %output = ();

  $output{product} = dnsQuoteEscape($table{product});
  $output{note}    = dnsQuoteEscape($table{location});
  $output{ty}      = dnsQuoteEscape($table{type});

  if (!defined($table{providers}) && $table{web} && defined($extraname) &&
      ($extraname eq 'lpd' | $extraname eq 'socket')) {
    # adminurl is deprecated for IPP
    $output{adminurl} = "http://" . dnsQuoteEscape($table{fqdn}) . '/';
  }

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

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

  my %extra = ();

  if (defined($extraname) && defined($table{$extraname})) {
    %extra = %{$table{$extraname}};
  }

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

  # convert hash to a string
  my $output = qq{"txtvers=1"\n};

  # RFC requests that description keys come before others in case of
  # packet truncation
  for my $dkey (qw(uuid rp ty product pdl note adminurl air priority qtotal tls usb_CMD usb_MDL usb_MFG)) {
    next unless $output{$dkey};
    $output .= qq{"$dkey=$output{$dkey}"\n};
    delete($output{$dkey});
  }

  # output any remaining keys
  for 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";

  # finally, associate a live machine name with the printer name
  for my $printer (sort keys %PRINTERS) {

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

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

    print DNS "\n\n;; $printer\n\n";

    for my $service (sort keys %SERVICES) {

      if ($PRINTERS{$printer}{$service}) {
	$sdTxt = dnsTxtHash($printer, $service);
	$sdTxt = '' if $service eq 'web'; # no params necessary
	print DNS << "EOS";
; Announce $printer ($service)
$SERVICES{$service} IN PTR $name.$SERVICES{$service}

; Zeroconf key-value pairs for $printer ($service)
$name.$SERVICES{$service} IN TXT (
$sdTxt)

; Hosts implementing $printer ($service)
EOS

	for my $p (@{$PRINTERS{$printer}{providers}}) {
	  print DNS << "EOP";
$name.$SERVICES{$service} IN SRV $p->{priority} $p->{weight} $PORTS{$service} $p->{fqdn}.
EOP
	}

	print DNS "\n";

      }
      elsif ($service ne 'web') { # don't defend web admin
	# For protocols that aren't used, we "defend" the protocol
	# by registering it with a port of zero
	print DNS << "EOLPD";
; Announce $printer ($service)
$SERVICES{$service} IN PTR $name.$SERVICES{$service}

; Service $service is not supported for $printer
EOLPD

	for my $p (@{$PRINTERS{$printer}{providers}}) {
	  print DNS << "EOP";
$name.$SERVICES{$service} IN SRV 0 0 0 $p->{fqdn}.
EOP
	}

	print DNS "\n";
      }

    } # end service iteration

  } # end printer iteration

  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 . "/hosts_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

  for my $printer (sort keys %PRINTERS) {
    for my $provider (@{$PRINTERS{$printer}{providers}}) {
      my $fqdn = $provider->{fqdn};
      (my $host) = ($fqdn =~ /^([^.]+)/);

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

      print DHCP << "EODHCP";

# $printer
host $host {
    hardware ethernet $provider->{macaddr};
    fixed-address $fqdn;
#    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: $!";

  for my $printer (sort keys %PRINTERS) {
    my %table = %{$PRINTERS{$printer}};
    for my $provider (@{$PRINTERS{$printer}{providers}}) {
      (my $host) = ($provider->{fqdn} =~ /^([^.]+)/);
      $table{hostname} = $host;

      my $tftpConfig = "";

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

      my $template = getTFTPTemplate($printer, $provider);

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

	eval $template or die "Template for $macaddr had error '$@'\n";

	print TFTP $tftpConfig;

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

  return 0;

} # end sub configTFTP


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

Generates a single SQL file containing insert/update (conditional)
statements that will refresh the information for the givent printer.

Returns a non-zero value if an error occurs.

=cut
sub configSQL() {

  open(SQL, '>', ($OUTPUT . "/macauth.sql"))
    or warn "Could not create SQL file: $!\n";

  print SQL << "EOSQLHEAD";
-- SQL INSERT/UPDATE statement for all printers
--
-- Paste into our NAC
--
-- See http://web.suffieldacademy.org/ils/netadmin/docs/printing/
--


EOSQLHEAD

  for my $printer (sort keys %PRINTERS) {
    for my $provider (@{$PRINTERS{$printer}{providers}}) {

      (my $host) = ($provider->{fqdn} =~ /^([^.]+)/);
      my $type = $PRINTERS{$printer}{type};
      my $location = $PRINTERS{$printer}{location};
      my $macaddr = $provider->{macaddr};
      $macaddr =~ s/[^0-9a-f]//g;

      my $description = "Printer $printer ($host: $location - $type)";
      $description =~ s/'/''/g; # escape single quote marks

      print SQL << "EOSQL";
INSERT INTO macroles (mac, role, description) VALUES
  ('$macaddr', 'gear-printers', '$description')
  ON DUPLICATE KEY UPDATE description='$description';

EOSQL

    }
  }

  close(SQL);

  return 0;

} # end sub configSQL



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

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

# Sanity check on output dir
$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);

# clean up data from file
for my $p (keys %PRINTERS) {

  my @providers = ();

  if (defined($PRINTERS{$p}{providers})) {
    @providers = @{$PRINTERS{$p}{providers}};
  }
  else {
    die "Printer '$p' doesn't have any providers defined\n";
  }

  if ($#providers == 0) { # only one provider
    # auto-generate hostnames
    genhostname($p);
  }

  for my $provider (@providers) {

    unless (defined($provider->{macaddr})) {
      die "No macaddr for provider of '$p'; aborting\n";
    }

    # convert MAC to lower case
    my $macaddr = lc($provider->{macaddr});
    $provider->{macaddr} = $macaddr;

    unless ($provider->{fqdn}) {
      die "No fqdn for provider of '$p'; aborting\n";
    }

    # ensure the priority/weights are populated
    unless ($provider->{priority}) {
      $provider->{priority} = 0;
    }
    unless ($provider->{weight}) {
      $provider->{weight} = 0;
    }

  }

  # convert all DNS-SD keys to lower case (they're case insensitive per RFC)
  for my $h (('default', keys %SERVICES)) {
    next unless defined($PRINTERS{$p}{$h});
    for my $k (keys %{$PRINTERS{$p}{$h}}) {
      my $klc = lc($k);
      if ($klc ne $k) { # needs to convert to lower case
	$PRINTERS{$p}{$h}{$klc} = $PRINTERS{$p}{$h}{$k};
	delete($PRINTERS{$p}{$h}{$k});
      }
    }
  }
}


# Now, dispatch with the rest of the arguments

for 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();
  }
  elsif ($arg eq 'sql') {
    $result = configSQL();
  }
  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