Bonjour Printing and DNS-SD records

#!/usr/bin/perl

#
# Global vars
#
use vars qw/ %opt /;
use Switch;

%rkeys = ();

# Defaults
# Everything in this hash will also be part of the dns-sd TXT record.

$rkeys{"txtvers"} = "1";
$rkeys{"qtotl"} = "3";
$rkeys{"pdl"} = "application/postscript";

# Stop edit here

#
# Default values
#
$ttl = 60;


#
# Command line options processing
#
sub init()
{
	use Getopt::Std;
	my $opt_string = 'hemt:n:d:s:z:f:p:N:';
	%opt=();
	getopts( "$opt_string", \%opt );
	if ((!%opt || $opt{h} || !$opt{t} || !$opt{n} || !$opt{d} || !$opt{s} || !$opt{z}) || ($opt{f} && $opt{p}) || (!$opt{f} && !$opt{p})) { usage(); }
}

#
# Message about this program and how to use it
#
sub usage()
{
	print STDERR << "EOF";

	How it works.

	usage: $0 [-h] [-e] [-m] [-N <note>] <-t type> <-n printername> <-d description> <-s server:priority:weight:port> <-z zone> <[-f ppd_file|-p product_string]>

	-h		: (this) help message.
	-e		: include extra dns-sd service discovery records.
	-m		: use Manufacturer and Model name from PPD. Default is to use Product name.
	-p		: use product_string instead of extracting information from PPD file.
	-t		: service type, can be one of "lpr", "ipp" or "other".
	-n		: printer name (no spaces, dots or special characters).
	-d		: printer description (printer friendly name).
	-s		: string prividing FQDN/IP of the print server, priority, weight and port of the service.
	-z 		: name of the zone where the service is to be published.
	-f 		: path to PPD file.

	$0 will output results to the standard output.

	examples:
                  $0 -e -t ipp -n HP -d "HP LaserJet 4050" -s print.hmonteiro.net:0:0:631 -z home.hmonteiro.net -p "(HP LaserJet 4050 Series )"
                  $0 -e -t ipp -n HP -d "HP LaserJet 4050" -s print.hmonteiro.net:0:0:631 -z home.hmonteiro.net -f HP.ppd

EOF
	exit;
}


# Adds dns-sd SRV browsing records
sub dnssd
{
	print "\n";
	print "# Service browsing\n";
	print "^b._dns-sd._udp.$zone:$zone:60::in\n";
	print "^lb._dns-sd._udp.$zone:$zone:60::in\n";
	print "\n";
	print "# Available services\n";
	print "^_services._dns-sd._udp.$zone:_ipp._tcp.$zone:60::in\n";
	print "^_services._dns-sd._udp.$zone:_printer._tcp.$zone:60::in\n";
	print "^_services._dns-sd._udp.$zone:_pdl-datastream._tcp.$zone:60::in\n";
	print "\n";
}


sub buildsrv
{
	my ($srv) = @_;
	my ($server, $prio, $weight, $port, $service)  = split /:/, $srv;
    if ( ( $prio >= 0 && $prio <= 65535 ) &&
	 ( $weight >= 0 && $weight <= 65535 ) &&
	 ( $port >= 0 && $port <= 65535 ) ) {
	my $target = "";
	@chunks = split /\./, $server;
	foreach $chunk ( @chunks ) {
	    $target = $target . characterCount( $chunk ) . $chunk;
	}
	$result = ":" . escapeText( $service ) . ":33:" . escapeNumber( $prio ) . 
	    escapeNumber( $weight ) . escapeNumber( $port ) . 
	    $target . "\\000" . ":" . $ttl;

	return $result;

    }
    else {
		print "priority, weight or port not within 0 - 65535\n";
		exit (1);
    }
}

sub escapeNumber {
    my $number = pop @_;
    my $highNumber = 0;

    if ( $number - 256 >= 0 ) {
	$highNumber = int( $number / 256 );
	$number = $number - ( $highNumber * 256 );

    }
    $out = sprintf "\\%.3lo", $highNumber;
    $out = $out . sprintf "\\%.3lo", $number;

    return( $out );
}

sub escapeText {
	my $line = pop @_;
	my $out;
	my @chars = split //, $line;

	foreach $char ( @chars ) {
		if ( $char =~ /[\r\n\t: \\\/]/ ) {
			$out = $out . sprintf "\\%.3lo", ord $char;
		} else {
			$out = $out . $char;
		}
	}
	return( $out );
}

sub characterCount {
	my $line = pop @_;
	my @chars = split //, $line;
	my $count = @chars;

	return( sprintf "\\%.3lo", $count );
}

sub txtlen {
	my (%hash) = @_;
	my $ref = \%hash;
	my $str = "";
	my $strlen = 0;
	my $len = 0;
	my $ret = "";

	foreach (keys(%rkeys)) {
		$str = $_."=".$$ref{$_};
		$strlen = length($str);
		$len = 0;

		$len = $strlen+int($strlen/8)*2;
		$len = sprintf("%3d", $len);
		$len=~ tr/ /0/;

		$ret = $ret."\\$len$str";
	}

	return $ret;
}

sub getprod {
	my ($ppd, $use_mm) = @_;
	my @data = ();
	my $product = "";
	my $manufacturer = "";
	my $model = "";

	open(PPD, "< $ppd") or die "Can't open $ppd : $!";

	while (<PPD>) {
		chomp();
		($attribute,$value) = split(/:/,$_);
		if ($use_mm) {
			$manufacturer = $value if ($attribute eq "\*Manufacturer");
			$manufacturer =~ s/^\s+//;
			$model = $value if ($attribute eq "\*ModelName");
			$model =~ s/^\s+//;
		} else {
			$product = $value if ($attribute eq "\*Product");
			$product =~ s/^\s+//;
		}
	}
	close(PPD);
	if ($use_mm) {
		$product = "($manufacturer $model)";
	}
	$product =~ s/"//g;
	return $product;
}


# START of program

init();

$name = $opt{n};

if ($opt{t} eq "ipp") {
	$type = "_ipp";
	$rkeys{"rp"} = "printers/".$name;
}

if ($opt{t} eq "lpr") {
	$type = "_printer";
	$rkeys{"rp"} = $name;
}

if ($opt{t} eq "other") {
	$type = "_pdl-datastream";
	$rkeys{"rp"} = $name;
}

if ($opt{N}) {
	$rkeys{"note"} = $opt{N};
}

$rkeys{"ty"} = $opt{d};
$zone = $opt{z};
$srv = $opt{s}.":".$name.".".$type."._tcp.".$zone;
if ($opt{f}) {
	$ppd  = $opt{f};
	$rkeys{"product"} = getprod($ppd,$opt{m});
} else {
	$rkeys{"product"} = $opt{p};
}

if ( $opt{e} ) {
	dnssd($zone);
}

print "^$type._tcp.$zone:".$name.".".$type."._tcp.".$zone.":60::in\n";
print buildsrv($srv)."\n";
print ":".$name.".$type._tcp.".$zone.":16:".txtlen(%rkeys).":60\n";;
# END of program