#!/usr/bin/perl
# -*- mode:perl -*-
use strict;
use warnings;

sub BEGIN {
    # Fri Oct  8 12:21:59 2021 Give up on la vide tainted due to appimage-builder
    # Seal us up a bit for living la vida tainted
    # $ENV{'PATH'} = "/bin:/usr/bin";
    $ENV{'LC_ALL'} = "C";
    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
}

##
# Begin: common.pl.inc

use Carp;
use File::Path qw(make_path);
use File::Spec;
use File::Temp qw(tempdir);
use IO::Uncompress::Unzip qw($UnzipError);
use Digest::SHA qw(sha512_hex sha512);

sub VERSION { "1.0" }
sub MFZRUN_HEADER { "MFZ(".VERSION.")\n" }
sub MFZ_PUBKEY_NAME { "MFZPUBKEY.DAT" }
sub MFZ_FILE_NAME { "MFZNAME.DAT" }
sub MFZ_SIG_NAME { "MFZSIG.DAT" }
sub MFZ_ZIP_NAME { "MFZ.ZIP" }

use constant CDM_FORMAT_MAGIC => "CDM";
use constant CDM_FORMAT_VERSION_MAJOR => "1";
use constant CDM_FORMAT_VERSION_MINOR => "0";

use constant CDM10_PACK_SIGNED_DATA_FORMAT =>
    ""            #   0
    ."a6"         #   0 +   6 =    6 magic + maj + min + \n
    ."C1"         #   6 +   1 =    7 bits in block size
    ."C1"         #   7 +   1 =    8 regnum
    ."N"          #   8 +   4 =   12 slotstamp
    ."N"          #  12 +   4 =   16 mapped file length
    ."a16"        #  16 +  16 =   32 label
    ."a64"        #  32 +  64 =   96 sha512 mapped file checksum
    ."(a8)100"    #  96 + 800 =  896 100*8 byte xsum map
    #  896 total length
    ;

use constant CDM10_PACK_FULL_FILE_FORMAT =>
    ""            #   0
    ."a896"       #   0 + 896 =  896 as from CDM10_PACK_SIGNED_DATA_FORMAT
    ."a128"       # 896 + 128 = 1024 RSA sig by regnum of bytes 0..895
    # 1024 total length
    ;

my $programName = $0;  # default
sub SetProgramName {
    $programName = shift;
}

sub IDie {
    my $msg = shift;
    print STDERR "\nInternal Error: $msg\n";
    confess "I suck";
}

my $UDIE_MSG;
sub SetUDieMsg {
    $UDIE_MSG = shift;
}

sub UDie {
    my $msg = shift;
    IDie("Unset UDie message") unless defined $UDIE_MSG;
    print STDERR "\nError: $msg\n";
    print STDERR $UDIE_MSG;
    exit(1);
}

sub NoVerb {
    UDie("Missing command");
}

my $KeyDir;

sub InitMFMSubDir {
    my $sub = shift;
    IDie "No sub?" unless defined $sub;
    IDie "No KD?" unless defined $KeyDir;

    my $dir = "$KeyDir/$sub"; # $KeyDir should be clean and $sub should be internal

    if (!-d $dir) {
        make_path($dir)       # So we shouldn't need untainting to do this
            or die "Couldn't mkdir $dir: $!";
    }
    return $dir;
}

sub GetPublicKeyDir {
    return InitMFMSubDir("public_keys");
}

sub GetPublicKeyFile {
    my $handle = shift;
    my $ehandle = EscapeHandle($handle);
    my $dir = GetPublicKeyDir();
    my $pub = "$dir/$ehandle.pub";

    return $pub;
}

sub JoinHandleToKey {
    my ($handle, $keydata) = @_;
    my $data ="[MFM-Handle:$handle]\n$keydata";
    return $data;
}

sub SplitHandleFromKey {
    my $data = shift;
    $data =~ s/^\[MFM-Handle:(:?[a-zA-Z][-., a-zA-Z0-9]{0,62})\]\r?\n//
        or return undef;
    my $handle = $1;
    return ($handle,$data);
}

sub ComputeFingerprintFromFullPublicKey {
    my $fullpubkey = shift;
    my $fingerprint = lc(sha512_hex($fullpubkey));
    $fingerprint =~ s/^(....)(...)(....).+$/$1-$2-$3/
        or IDie("you're a cow");
    return $fingerprint;
}

sub ComputeChecksumOfString {
    my $string = shift;
    my $fingerprint = lc(sha512_hex($string));
    $fingerprint =~ s/^(......)(..).+(..)(......)$/$1-$2$3-$4/
        or IDie("give me some milk or else go home");
    return $fingerprint;
}

sub ComputeChecksumPrefixOfString {
    my ($string,$len) = @_;
    IDie("something is happening here but you don't know what it is")
        unless defined $len && $len >= 0 && $len <= 64;
    my $checksum = sha512($string);
    return substr($checksum,0,$len);
}

sub ReadPublicKeyFile {
    my $handle = shift;
    my $file = GetPublicKeyFile($handle);
    my $data = ReadWholeFile($file);
    my ($pubhandle, $key) = SplitHandleFromKey($data);
    UDie("Bad format in public key file '$file' for '$handle'")
        unless defined $pubhandle;
    UDie("Non-matching handle in public key file '$file' ('$handle' vs '$pubhandle')")
        unless $pubhandle eq $handle;
    return ($key, ComputeFingerprintFromFullPublicKey($data));
}

sub CheckForPubKey {
    my $handle = shift;
    my $path = GetPublicKeyFile($handle);
    if (-r $path) {
        return ($path, ReadPublicKeyFile($handle));
    }
    return ($path);
}

sub GetConfigDir {
    my $cfgdir = InitMFMSubDir("config");
    chmod 0700, $cfgdir;
    return $cfgdir;
}

sub GetLegalHandle {
    my $handle = shift;
    if ($handle eq "-") {
        my $defaulthandle = GetDefaultHandle();
        if (!defined $defaulthandle) {
            print STDERR "ERROR: No default handle, so cannot use '-' as handle (try 'mfzmake help'?)\n";
            exit 1;
        }
        return $defaulthandle;
    }

    UntaintHandleIfLegal(\$handle)
        or UDie("Bad handle '$handle'");
    return $handle;
}

sub GetLegalRegnum {
    my $regnum = shift;
    UDie("Not a number '$regnum'")
        unless $regnum =~ /^(\d+)$/;
    my $num = $1;
    UDie("Illegal regnum $num")
        unless $regnum >= 0 && $regnum < (1<<16);
    my @regnumHandles = (
        "t2-keymaster-release-10"
        );
    my $handle = $regnumHandles[$num];
    UDie("Invalid regnum $num")
        unless defined $handle;
    return ($num, $handle);
}

sub GetDefaultHandleFile {
    my $dir = GetConfigDir();
    my $def = "$dir/defaultHandle";
    return $def;
}

sub GetDefaultHandle {
    my $file = GetDefaultHandleFile();
    if (-r $file) {
        my $handle = ReadWholeFile($file);
        return $handle if UntaintHandleIfLegal(\$handle);
    }
    return undef;
}

sub GetPrivateKeyDir {
    my $privdir = InitMFMSubDir("private_keys");
    chmod 0700, $privdir;
    return $privdir;
}

sub GetPrivateKeyFile {
    my $handle = shift;
    my $ehandle = EscapeHandle($handle);
    my $dir = GetPrivateKeyDir();
    my $pub = "$dir/$ehandle.priv";
    return $pub;
}

sub ReadPrivateKeyFile {
    my $handle = shift;
    my $file = GetPrivateKeyFile($handle);
    my $data = ReadWholeFile($file);
    my ($privhandle, $key) = SplitHandleFromKey($data);
    UDie("Bad format in private key file for '$handle'")
        unless defined $privhandle;
    UDie("Non-matching handle in private key file ('$handle' vs '$privhandle')")
        unless $privhandle eq $handle;
    return $key;
}

sub VersionExit {
    my $pname = shift;
    $pname = "" unless defined $pname;
    print "$pname-".VERSION."\n";
    exit(0);
}

sub GetKeyDir {
    IDie("No key dir?") unless defined $KeyDir;
    return $KeyDir;
}

sub KDGetVerb {
    my $mustExist = shift;
    my $verb = NextArg();
    NoVerb() if $mustExist && !defined $verb;
    my $kdir;
    if (defined($verb) && $verb eq "-kd") {
        $kdir = NextArg();
        UDie("Missing argument to '-kd' switch") 
            unless defined $kdir;
        $verb = NextArg();
        NoVerb() if $mustExist && !defined $verb;
    } else {
        $kdir = glob "~/.mfm";
    }

    # Let's avoid accidentally creating keydir 'help' or whatever..
    UDie("-kd argument ('$kdir') must begin with '/', './', or '../'")
        unless $kdir =~ m!^([.]{0,2}/.*)$!;
    $KeyDir = $1;

    if (-e $KeyDir) {
        UDie("'$KeyDir' exists but is not a directory")
            if ! -d $KeyDir;
    }
    return $verb;
}

sub NextArg {
    my $arg = shift @ARGV;
    return $arg;
}

sub LastArg {
    my $arg = NextArg();
    my @more = RestOfArgs();
    UDie("Too many arguments: ".join(" ",@more))
        if scalar(@more);
    return $arg;
}

sub RestOfArgs {
    my @args = @ARGV;
    @ARGV = ();
    return @args;
}

sub ReadableFileOrDie {
    my ($text, $path) = @_;
    UDie "No $text provided" unless defined $path;
    UDie "Non-existent or unreadable $text: '$path'"
        unless -r $path and -f $path;
    $path =~ /^(.+)$/
      or IDie("am i here all alone");
    return $1;
}

sub WritableFileOrDie {
    my ($text, $path) = @_;
    UDie "No $text provided" unless defined $path;
    UDie "Unwritable $text: '$path': $!" unless -w $path or !-e $path;
    $path =~ /^(.+)$/
      or IDie("hands you a bone");
    return $1;
}

sub ReadWholeFile {
    my $file = shift;
    open (my $fh, "<", $file) or IDie("Can't read '$file': $!");
    local $/ = undef;
    my $content = <$fh>;
    close $fh or IDie("Failed closing '$file': $!");
    return $content;
}

sub WriteWholeFile {
    my ($file, $content, $perm) = @_;
    open (my $fh, ">", $file) or UDie("Can't write '$file': $!");
    chmod $perm, $fh
        if defined $perm;
    print $fh $content;
    close $fh or IDie("Failed closing '$file': $!");
}

sub UntaintHandleIfLegal {
    my $ref = shift;
    return 0
        unless $$ref =~ /^\s*(:?[a-zA-Z][-., a-zA-Z0-9]{0,62})\s*$/;
    $$ref = $1;
    return 1;
}

sub EscapeHandle {
    my $handle = shift;
    chomp($handle);
    $handle =~ s/([^a-zA-Z0-9])/sprintf("%%%02x",ord($1))/ge;
    return $handle;
}

sub UnzipStreamToMemory {
    my ($u) = @_;
    my @paths;

    my $status;
    my $count = 0;
    for ($status = 1; $status > 0; $status = $u->nextStream(), ++$count) {
        my $header = $u->getHeaderInfo();
        my $stored_time = $header->{'Time'};
        $stored_time =~ /^(\d+)$/ or die "Bad stored time: '$stored_time'";
        $stored_time = $1;  # Untainted

        my $fullpath = $header->{Name};
        my (undef, $path, $name) = File::Spec->splitpath($fullpath);

        if ($name eq "" or $name =~ m!/$!) {
            last if $status < 0;
        } else {

            my $data = "";
            my $buff;
            while (($status = $u->read($buff)) > 0) {
                $data .= $buff;
            }
            if ($status == 0) {
                push @paths, [$path, $name, $stored_time, $data];
            }
        }
    }

    die "Error in processing: $!\n"
        if $status < 0 ;
    return @paths;
}

sub UnzipStream {
    my ($u, $dest) = @_;
    my @paths;

    $dest = "." unless defined $dest;

    my $status;
    my $count = 0;
    for ($status = 1; $status > 0; $status = $u->nextStream(), ++$count) {
        my $header = $u->getHeaderInfo();
        my $stored_time = $header->{'Time'};
        $stored_time =~ /^(\d+)$/ or die "Bad stored time: '$stored_time'";
        $stored_time = $1;  # Untainted

        my (undef, $path, $name) = File::Spec->splitpath($header->{Name});
        my $destdir = "$dest/$path";

        my $totouch;
        unless (-d $destdir) {
            make_path($destdir)
                or die "Couldn't mkdir $destdir: $!";
            $totouch = $destdir;
        }
        if ($name eq "" or $name =~ m!/$!) {
            last if $status < 0;
        } else {

            my $destfile = "$destdir$name";
            my $buff;
#            print STDERR "Writing $destfile\n";
            my $fh = IO::File->new($destfile, "w")
                or die "Couldn't write to $destfile: $!";
            my $length = 0;
            while (($status = $u->read($buff)) > 0) {
                 $length += length($buff);
#                print STDERR "Read ".length($buff)."\n";
                $fh->write($buff);
            }
            $fh->close();
            $totouch = $destfile;
            push @paths, [$destdir, $name, $stored_time, $length];
        }

        utime ($stored_time, $stored_time, $totouch)
            or die "Couldn't touch $totouch: $!";
    }

    die "Error in processing: $!\n"
        if $status < 0 ;
    return @paths;
}

# Returns:
# undef if $findName (in option $findPath) is not found,
# [$destdir, $name, $stored_time] if $pref is data from UnzipStream
# [$path, $name, $stored_time, $data] if $pref is data from UnzipStreamToMemory

sub FindName {
    my ($pref, $findName, $findPath) = @_;
    my @precs = @{$pref};
    for my $rec (@precs) {
        my @fields = @{$rec};
        my ($path, $name) = @fields;
        if ($name eq $findName) {
            if (!defined($findPath) || $path eq $findPath) {
                return @fields;
            }
        }
    }
    return undef;
}

sub SignStringRaw {
    my ($privkeyfile, $datatosign) = @_;

    my $keystring = ReadWholeFile( $privkeyfile );
    my $privatekey = Crypt::OpenSSL::RSA->new_private_key($keystring);
    $privatekey->use_pkcs1_padding();
    $privatekey->use_sha512_hash();
    my $signature = $privatekey->sign($datatosign);
    return $signature;
}

sub SignString {
    my ($privkeyfile, $datatosign) = @_;
    my $signature = SignStringRaw($privkeyfile, $datatosign);
    return encode_base64($signature, '');
}


# End: common.pl.inc
###
SetUDieMsg("Type '$0 help' for help\n");

use Crypt::OpenSSL::RSA;

use MIME::Base64  qw(encode_base64);

use IO::Compress::Zip qw(zip $ZipError);

use Cwd 'abs_path';

sub Help {
    my $v = VERSION;
    print <<EOH;

MFZ format file packer version $v

SYNOPSIS: $0 [-kd KEY_DIRECTORY] COMMAND FILES..

  KEY_DIRECTORY defaults to ~/.mfm/ if -kd is omitted

COMMAND FORMS:

$0 help  [or]  -h  [or]  --help

    Print this help and exit

$0 version   [or]  -v

    Print mfzmake version number and exit

$0 make HANDLE MFZFILETOMAKE filetopack1 filetopack2..

    Create a mfz file named MFZFILETOMAKE that can be run by mfzrun
    containing the supplied files (along with the HANDLE's public
    keyfile), signed by HANDLE's private key.  If HANDLE is '-',
    use the default handle (see 'mfzmake default', below).

    Certain filetopack names and globs are recognized and handled
    specially by mfzmake and/or mfzrun, including (for any FOO):

       (1) FOO.so    -> mfzrun maps this to -ep FOO.so
       (2) FOO.mfs   -> mfzrun maps this to -cp FOO.mfs
       (3) FOO.ulam  -> unused by mfzrun (but ulam might use)
       (4) args.txt  -> mfzrun adds first line to simulator arguments

    Other files are accepted and packed by mfzmake, but unused by mfzrun.

$0 cdmake REGNUM SLOTNUM LABEL filetopack1 filetopack2..

    Like '$0 make',
    except takes the REGNUM of a registered handle instead of the
    handle name itself, the SLOTNUM of the resulting content instead
    of an MFZ filename, plus an up-to-16 byte LABEL.  'cdmake' is
    required for .mfz files that are managed by CDM on a T2 tile grid.

$0 keygen HANDLE

    Generate a signing key for HANDLE.

$0 default HANDLE

    Make HANDLE (which must already exist) be the default handle for
    this user.  If HANDLE is '-', remove any existing default handle.

$0 cansign HANDLE

    Exit successfully if HANDLE can be used for signing (meaning both
    public and private portions of it are accessible), otherwise exit
    status 6

$0 canvalidate HANDLE

    Exit successfully if HANDLE can be used for validation (meaning at
    least the public portion of it is accessible), otherwise exit
    status 7.

$0 keydel HANDLE

    Delete the public and private portions of HANDLE.

$0 burn HANDLE

    Delete only the private portion of HANDLE.  HANDLE will no longer
    be usable for signing .mfz files, but will still be available to
    validate previously-signed .mfz files.

EOH
    exit(0);
}

my @zipOtherOptions;
ConfigureZipOptions();  # Ubuntu 12.04's zip module doesn't know CanonicalName! :(

my $verb = KDGetVerb(1);

Help() if $verb eq "help" or $verb eq "-h" or $verb eq "--help";
VersionExit("mfzmake") if $verb eq "version" or $verb eq "-v";
UDie("Unknown switch '$verb'") if $verb =~ /^-/;

DoCDMake() if $verb eq "cdmake";
DoMake() if $verb eq "make";
DoKeygen() if $verb eq "keygen";
DoKeydel() if $verb eq "keydel";
DoCanSign() if $verb eq "cansign";
DoCanValidate() if $verb eq "canvalidate";
DoBurn() if $verb eq "burn";
DoDefaultHandle() if $verb eq "default";
DoVerify() if $verb eq "verify";
UDie("Unknown command '$verb'");

############################3
# DoMake / DoCDMake

sub DoMake {
    my $handle = GetLegalHandle(NextArg());
    my $mfzfile = NextArg();
    my $innertime = MakeNextZipTime();
    DoMakeWithHandle($handle,$mfzfile,$innertime); # regnum and later args undef
}

sub DoCDMake {
    my ($regnum,$handle) = GetLegalRegnum(NextArg());
    my ($slotnum) = GetLegalSlotnum(NextArg());
    my ($label) = GetLegalLabel(NextArg());
    my ($innertime,$stamptime) = MakeNextZipTime();
    my $mfzfile = sprintf("cdmss-%02x-%06x.mfz",$slotnum,$stamptime);
    UDie("File '$mfzfile' already exists.  Maybe wait a couple minutes, tiger?")
        if -e $mfzfile;
    DoMakeWithHandle($handle,$mfzfile,$innertime,$regnum,$slotnum,$stamptime,$label);
}

sub DoMakeWithHandle {
    my ($handle,$mfzfile,$assignedinnertime,$regnum,$slotnum,$stamptime,$label) = @_;

    my $privkeyfile = GetPrivateKeyFile($handle);
    $privkeyfile = ReadableFileOrDie("private key file", $privkeyfile);

    my $pubkeyfile =  GetPublicKeyFile($handle);
    $pubkeyfile = ReadableFileOrDie("public key file", $pubkeyfile);

    my $pubkeydata = ReadWholeFile($pubkeyfile);

    $mfzfile = WritableFileOrDie("MFZ file", $mfzfile);
    $mfzfile =~ /[.]mfz$/ or UDie("Supplied MFZ filename '$mfzfile' doesn't end in '.mfz'");
    ((!-e $mfzfile) || (-f $mfzfile && -w $mfzfile)) or UDie("MFZ filename '$mfzfile' is not writable");

    my (undef,undef,$mfzfilename) =  File::Spec->splitpath($mfzfile);

    my @files = RestOfArgs();
    scalar(@files) or UDie("No files to pack?");

    for my $file (@files) {
        ReadableFileOrDie("file to pack", $file);
    }

    my ($inner,$innertime) = MakeInnerZip($pubkeydata,$mfzfilename,$assignedinnertime, @files);

    my $signed = SignString($privkeyfile, $inner);
#    WriteWholeFile($mfzfile,MFZRUN_HEADER.$signed.$inner,0644);
    my $outer = MFZRUN_HEADER.MakeOuterZip($signed,$inner,undef);

    my $cdmmap = ""; # Assume pure MFZ format
    if (defined($regnum)) {
        $cdmmap = MakeCDMMap($regnum,$slotnum,$stamptime,$mfzfilename,$privkeyfile,$outer,$innertime,$label);
    }

    WriteWholeFile($mfzfile,$cdmmap.$outer,0644);
    print "Wrote '$mfzfile'\n";
    exit 0;
}

############################3

sub DoVerify {
    my $mfzpath = NextArg();
    IDie "IMPLEMENT ME";
}

sub DoKeygen {
    my $handle = LastArg();

    UntaintHandleIfLegal(\$handle)
        or UDie("Bad handle '$handle'");

    my $privkeyfile = GetPrivateKeyFile($handle);
    $privkeyfile = WritableFileOrDie("private key file", $privkeyfile);

    my $pubkeyfile =  GetPublicKeyFile($handle);
    $pubkeyfile = WritableFileOrDie("public key file", $pubkeyfile);

    my $errors = 0;
    if (-e $privkeyfile) {
        ++$errors;
        print STDERR "ERROR: A private key file for '$handle' already exists ($privkeyfile)\n";
    }
    if (-e $pubkeyfile) {
        ++$errors;
        print STDERR "ERROR: A public key file for '$handle' already exists ($pubkeyfile)\n";
    }
    if ($errors > 0) {
        my $desc = "that file";
        if ($errors > 1) {
            $desc = "those files";
        }
        print STDERR "ERROR: Generally you shouldn't reuse handle names with different keys!\n";
        print STDERR "ERROR: But if you really want new keys for '$handle', perhaps first try\n";
        print STDERR "ERROR: '$0 keydel $handle' to remove $desc\n";
        exit 4;
    }

    my $rsa = Crypt::OpenSSL::RSA->generate_key(1024);

    my $privkey =  $rsa->get_private_key_string();
    my $fullprivkey = JoinHandleToKey($handle,$privkey);
    WriteWholeFile($privkeyfile, $fullprivkey, 0600);

    my $pubkey = $rsa->get_public_key_string();
    my $fullpubkey = JoinHandleToKey($handle,$pubkey);
    WriteWholeFile($pubkeyfile, $fullpubkey);

    # calculate digest from string/buffer
    my $fingerprint = ComputeFingerprintFromFullPublicKey($fullpubkey);

    print "Handle: \"$handle\" ($fingerprint) @ $pubkeyfile\n";
    exit 0;
}

sub DoKeydel {
    my $handle = LastArg();
    UntaintHandleIfLegal(\$handle)
        or UDie("Bad handle '$handle'");

    my $privkeyfile = GetPrivateKeyFile($handle);
    $privkeyfile = WritableFileOrDie("private key file", $privkeyfile);

    my $pubkeyfile =  GetPublicKeyFile($handle);
    $pubkeyfile = WritableFileOrDie("public key file", $pubkeyfile);

    my $havepriv = -e $privkeyfile;
    my $havepub = -e $pubkeyfile;

    if (!$havepriv && !$havepub) {
        print STDERR "ERROR: No private or public key file for '$handle' found\n";
        exit 5;
    }
    
    my $errors = 0;
    if ($havepriv && !unlink $privkeyfile) {
        ++$errors;
        print STDERR "ERROR: Couldn't remove private key file '$privkeyfile' for '$handle': $!\n";
    }
    if ($havepub && !unlink $pubkeyfile) {
        ++$errors;
        print STDERR "ERROR: Couldn't remove public key file '$pubkeyfile' for '$handle': $!\n";
    }
    if ($errors > 0) {
        my ($s,$n) = ("", "s");
        if ($errors > 1) {
            $s = "s";
            $n = "";
        }
        print STDERR "ERROR: $errors file$s remain$n undeleted for '$handle'\n";
        exit 5;
    }
    exit 0;
}

sub DoCanSign {
    my $handle = LastArg();
    CheckFilesInternal($handle,1,1,6);
    exit(0);
}

sub DoCanValidate {
    my $handle = LastArg();
    CheckFilesInternal($handle,0,1,7);
    exit(0);
}

sub CheckFilesInternal {
    my ($handle,$needpriv,$needpub,$badexit) = @_;

    UntaintHandleIfLegal(\$handle)
        or UDie("Bad handle '$handle'");

    my $privkeyfile = GetPrivateKeyFile($handle);
    $privkeyfile = WritableFileOrDie("private key file", $privkeyfile);

    my $pubkeyfile =  GetPublicKeyFile($handle);
    $pubkeyfile = WritableFileOrDie("public key file", $pubkeyfile);

    my $havepriv = -r $privkeyfile;
    my $havepub = -r $pubkeyfile;

    my $errors = 0;
    if ($needpriv && !$havepriv) {
        print STDERR "ERROR: Missing or unreadable private key file for '$handle' ($privkeyfile)\n";
        ++$errors;
    }
    if ($needpub && !$havepub) {
        print STDERR "ERROR: Missing or unreadable public key file for '$handle' ($pubkeyfile)\n";
        ++$errors;
    }
    
    if ($errors > 0) {
        my ($s,$n) = ("", "s");
        if ($errors > 1) {
            $s = "s";
            $n = "";
        }
        print STDERR "ERROR: $errors file$s inaccessible for '$handle'\n";
        exit $badexit;
    }
}

sub DoBurn {
    my $handle = LastArg();
    UntaintHandleIfLegal(\$handle)
        or UDie("Bad handle '$handle'");

    my $privkeyfile = GetPrivateKeyFile($handle);
    $privkeyfile = WritableFileOrDie("private key file", $privkeyfile);

    my $pubkeyfile =  GetPublicKeyFile($handle);
    $pubkeyfile = WritableFileOrDie("public key file", $pubkeyfile);

    my $havepriv = -e $privkeyfile;
    my $havepub = -e $pubkeyfile;

    if (!$havepub) {
        print STDERR "WARNING: No public key for '$handle' found ($pubkeyfile)\n";
        exit 6;
    }
    
    if (!$havepriv) {
        print STDERR "('$handle' has public key, but no private key found, OK)\n";
        exit 0;
    }

    if (!unlink $privkeyfile) {
        print STDERR "ERROR: Couldn't remove private key file '$privkeyfile' for '$handle': $!\n";
        exit 7;
    }
    exit 0;
}

sub DoDefaultHandle {
    my $handle = LastArg();
    if ($handle eq "-") {
        my $defaulthandlefile = GetDefaultHandleFile();
        if (!-e $defaulthandlefile) {
            print STDERR "WARN: No default handle to remove\n";
        } else {
            if (unlink $defaulthandlefile) {
                print STDERR "NOTE: Default handle cleared\n";
            } else {
                print STDERR "WARN: Could not remove '$defaulthandlefile': $!\n";
                exit 1;
            }
        }
        exit 0;
    }

    UntaintHandleIfLegal(\$handle)
        or UDie("Bad handle '$handle'");

    my $privkeyfile = GetPrivateKeyFile($handle);
    if (!-e $privkeyfile) {
        print STDERR "ERROR: Handle '$handle' not found\n";
        exit 1;
    }
    $privkeyfile = ReadableFileOrDie("private key file", $privkeyfile);

    my $defaulthandlefile = GetDefaultHandleFile();
    my $old = GetDefaultHandle();
    if (defined $old) {
        if ($handle ne $old) {
            print STDERR "WARN: Replacing previous default handle '$old'\n";
        }
    }
    WriteWholeFile($defaulthandlefile,$handle,0700);
    if (!defined $old) {
        print STDERR "NOTE: '$handle' set as default handle\n";
    }
    exit 0;
}


############################
# Internal routines
# convert module-name to path

sub GetModuleVersion {
    my $mod = shift;
    my $file = $mod;
    $file =~ s{::}{/}gsmx;
    $file .= '.pm';

    # Pull in the module, if it exists
    eval { require $file }
    or die "can't find module $mod\n";

    # Get the version from the module, if defined
    my $ver;
    { no strict 'refs';
      $ver = ${$mod . "::VERSION"} || 'UNKNOWN';
    }
    return $ver;
}

sub ConfigureZipOptions {
    my $zipVer = GetModuleVersion("IO::Compress::Zip");
    if ($zipVer >= 2.039) {
        @zipOtherOptions = ( CanonicalName => 1 );
    }
#    print "$zipVer/@zipOtherOptions\n";
}

sub MakeSlotStamp {
    my ($slotnum,$stamptime) = @_;
    IDie("Bad slotnum") if $slotnum <= 0 || $slotnum > 255;
    IDie("Bad stamptime") if $stamptime < 0 || $slotnum >= (1<<24);
    my $slotstamp = ((($slotnum)&0xff)<<24)|($stamptime&((1<<24)-1));
    return $slotstamp;
}

sub MakeCDMMap {
    my ($regnum,$slotnum,$stamptime,$mfzfilename,$privkeyfile,$outer,$innertime,$label) =
        @_;
    my $slotstamp = MakeSlotStamp($slotnum,$stamptime);
    my $mappedFileLen = length($outer);
    my $bitsInBlock = 8;
    do ++$bitsInBlock while (1<<$bitsInBlock) * 100 < $mappedFileLen;
    my $blockSize = (1<<$bitsInBlock);
    my @xsums = ("") x 100;
    my $sha = Digest::SHA->new(512);
    my $lastfullxsum;
    for (my $block = 0; $block<100;++$block) {
        my $offset = $blockSize*$block;
        last if $offset > $mappedFileLen;
        my $chunk = substr($outer,$offset,$blockSize); # blockSize or til eof
        $sha->add($chunk);
        $lastfullxsum = $sha->clone()->digest();
        my $xsum8 = substr($lastfullxsum,0,8);
        $xsums[$block] = $xsum8;
    }
    my $maptosign =
        pack(CDM10_PACK_SIGNED_DATA_FORMAT,
             CDM_FORMAT_MAGIC.CDM_FORMAT_VERSION_MAJOR.CDM_FORMAT_VERSION_MINOR."\n",
             $bitsInBlock,
             $regnum,
             $slotstamp,
             $mappedFileLen,
             $label,
             $lastfullxsum,
             @xsums);
    IDie("Bad pack") unless length($maptosign) == 896;
    my $signature = SignStringRaw($privkeyfile, $maptosign);
    IDie("Bad sign") unless length($signature) == 128;
    my $cdmmap =
        pack(CDM10_PACK_FULL_FILE_FORMAT,
             $maptosign,
             $signature);
    IDie("Bad map") unless length($cdmmap) == 1024;
    return $cdmmap;
}

sub GetLegalSlotnum {
    my $slotnum = shift;
    UDie("Missing slotnum")
        unless defined $slotnum;
    UDie("Illegal slotnum '$slotnum'")
        unless $slotnum =~ /^([[:xdigit:]]{1,2})$/;
    my $num = hex($1);
    UDie("Illegal slotnum $num")
        unless $num > 0 && $num < 256; # 00 reserved as illegal slotnum
    return $num;
}

sub GetLegalLabel {
    my $label = shift;
    UDie("Missing label")
        unless defined $label;
    UDie("Illegal label '$label'")
        unless  $label =~ /^([[:print:]]+)$/;
    my $val = $1;
    my $maxlen = 16;
    UDie("Label too long '$label' (max $maxlen)")
        unless length($label) <= $maxlen;
    return $val;
}

sub MakeNextZipTime {
    # Reminder: A snippet from stackoverflow.com: 
    #   Zip entry timestamps are recorded only to two 2 second
    #   precision. This reflects the accuracy of DOS timestamps in use
    #   when PKZIP was created. That number recorded in the Zip will
    #   be the timestamp truncated, not the nearest 2 seconds.
    #
    # So I guess this is 'correct' rather than 'a hack':
    my $assignedinnertime = int(time()/2)*2; 

    # We also (may) want the low-res 'slotstamp' granularity time
    my $stamp = int($assignedinnertime/(60*5)); # seconds -> 5 minute chunks
    return ($assignedinnertime,$stamp);
}

sub MakeInnerZip {
    my ($pubkeydata,$mfzfilename,$assignedinnertime,@files) = @_;
    my $compressedoutput;

    my $z = new IO::Compress::Zip
        \$compressedoutput,
        Name          => MFZ_PUBKEY_NAME,
        Time          => $assignedinnertime,
        @zipOtherOptions,
        BinModeIn     => 1
        or IDie("Zip init failed for inner: $ZipError");
    $z->print ($pubkeydata);

    $z->newStream(
        Name          => MFZ_FILE_NAME,
        Time          => $assignedinnertime,
        @zipOtherOptions,
        BinModeIn     => 1)
        or die "Zip reinit failed on ".MFZ_FILE_NAME.": $ZipError\n";
    $z->print ($mfzfilename);

    for my $file (@files) {
        my $origFile = $file;
        $file = abs_path($file);
        # Check top-level special files after path normalization
        UDie("'$origFile' is handled automatically, cannot pack it explicitly")
            if $file eq "/".MFZ_PUBKEY_NAME
            or $file eq "/".MFZ_FILE_NAME;

        open (my $fh, "<", $file) or UDie("Can't read '$file': $!");
        my $modtime = (stat($fh))[9];

        $z->newStream(
            Name          => $file,
            @zipOtherOptions,
            BinModeIn     => 1,
            Time          => $modtime,
            ExtAttr       => 0666 << 16)
            or die "Zip reinit failed on '$file': $ZipError\n";

        while (<$fh>) { $z->print ($_); }
        close $fh or IDie("Failed closing '$file': $!");
    }

    close $z;
    return ($compressedoutput,$assignedinnertime);
}

sub MakeOuterZip {
    my ($signature,$inner,$announce) = @_;
    my $compressedoutput;
    my $z = new IO::Compress::Zip
        \$compressedoutput,
        Name          => MFZ_SIG_NAME,
        @zipOtherOptions,
        BinModeIn     => 1
        or IDie("Zip init failed for outer: $ZipError");
    $z->print($signature);

    $z->newStream(
        Name          => MFZ_ZIP_NAME,
        @zipOtherOptions,
        BinModeIn     => 1,
        ExtAttr       => 0666 << 16)
        or die "Zip reinit failed for outer: $ZipError\n";
    $z->print($inner);

    if (defined $announce) {
        IDie("Why are you here? ANNOUNCING doesn't exist anymore");
    }

    close $z;
    return $compressedoutput;
}

## REACHED EOF
exit 2;
