#!/usr/bin/perl
# ModMan
# An utility for GranJefe's modules MANIFEST handling
# © 2015-2025 Matías Software Group
#
# $Id: ModMan 4047 2019-06-10 23:01:45Z sog $
use strict;
use warnings;
use utf8;
use open ':utf8';

use IO::File;
use File::Find;
use File::Spec;
use File::Temp;
use Tie::IxHash;
use File::MimeInfo ();
use Crypt::OpenSSL::Common;
use Crypt::OpenSSL::RSA;
use Crypt::OpenSSL::X509 qw(FORMAT_ASN1);
use Crypt::OpenSSL::Bignum;
use MIME::Base64();
use Digest::SHA1;
use YAML::Tiny 1.39 ();
use JSON;
use Data::Dumper;
use Encode;
use Getopt::Long qw(:config no_ignore_case);
use Config;
use lib ((my $lib = $Config{archlib}) =~ s|perl5|GranJefe/plib|r);
use SimpleMime;

use version; our $VERSION = qv('v3.0.2');
$Data::Dumper::Useperl = 1;

BEGIN {
    # Hack YAML::Tiny to NOT sort hash on tied HASHes
    require B::Deparse;
    if(my $write_hash = B::Deparse->new()->coderef2text(\&YAML::Tiny::_dump_hash)) {
        $write_hash
           =~ s/sort keys %\$hash/tied(%\$hash)?(keys %\$hash):(sort keys %\$hash)/;
        $write_hash
            =~ s/refaddr/Scalar::Util::refaddr/;
        #warn "WH: $write_hash\n";
        no warnings 'redefine';
        *YAML::Tiny::_dump_hash = eval "sub $write_hash" or die "Oops!: $@";
    }
    require Archive::Zip;
    Archive::Zip->import(qw(:ERROR_CODES :CONSTANTS));
}

our $ManFile;
my $verbose = 0;

my @ForSign = qw(
    Name Version Package Arch Build
    Attrs Framework
    Modules Library Conf
);
my @PrefOrder = (@ForSign, qw(Path Signature Seal Signer Signed));

die "Not in a module directory!\n" unless -d 'plib';

my $Package = '';
my %Origs = ();
my $Signer = undef;

my %Paths = (
    Modules => 'plib',
    Library => 'lib',
    Conf    => 'conf',
);

sub CannonForm {
    my ($ref, $mode) = @_;
    my $string;
    if($mode) { # 'port'
        $string = JSON::to_json($ref, { canonical => 1 });
    } else { # Legacy
        $string = Data::Dumper->new([$ref],['H'])
                ->Indent(0)
                ->Pair(':')
                ->Sortkeys(1)
                ->Dump();
        $string =~ s/\$H\s*=\s*//;
    }
    warn "CF: '$string', mode: '$mode'\n" if $verbose;
    return $string;
}

my %Adds = (
    Modules => 0,
    Library => 0,
    Conf => 0
);
sub defhash {
    my($section, $file) = @_;
    my $dir = $Paths{$section};
    my $hash = {};
    if($Origs{$dir}{$file}) {
        $hash = delete $Origs{$dir}{$file};
    } else {
        warn "Added files in $section\n" unless $Adds{$section}++;
        warn "\t$file\n";
    }
    if($dir eq 'lib' && !$hash->{ct}) {
        my $mt = SimpleMime::mimetype($file) || File::MimeInfo::globs($file) || 'application/octect-stream';
        $mt .= '; charset=UTF-8' if $mt =~ /^text/ && $mt !~ /charset/;
        $hash->{ct} = $mt;
        warn "Add CT: $mt to $file\n"
    }
    return $hash;
}

my %ignores = map { (".$_" => 1) } qw(svn git npm);

sub FindFiles {
    my($Manifest, $section) = @_;
    my $dir = $Paths{$section};
    $Manifest->{$section} = {};
    return unless -d $dir;
    my $remove = "$dir/";
    $remove .= "$Package/" if $dir eq 'lib' && $Package;
    find({no_chdir=>1, preprocess => sub { sort @_ }, wanted => sub {
        if(-d and exists $ignores{$_}) {
            $File::Find::prune = 1;
            return;
        }
        if(!$Package and
            $dir eq 'plib' && m{^plib/(.*).pm} ||
            $dir eq  'lib' && m{^lib/(.*)}
        ) {
            $Package = $1;
            if($dir eq 'plib') {
                $Package =~ s/\//::/g;
            } else {
                $remove .= "$Package/";
            }
            warn "Found package $Package\n" if $verbose;
            return if -d;
        }
        if(-f) {
            s/^$remove//;
            return if /^\./ || /\.swp$/ || /.gitkeep$/;
            my $hr = defhash($section, $_);
            $Manifest->{$section}{$_} = $hr;
        }
        if(-d) {
            if($_ eq $dir || $_ eq "lib/$Package") {
                $_ = '.';
            } else {
                s/^$remove//;
            }
            my $ne = delete($Origs{$dir}{$_}) || { is_dir => "1" };
            $Manifest->{$section}{$_} = $ne;
        }
    }},$dir);
    return $Manifest;
}

sub LoadManifest {
    my $manfile = shift;
    my($Manifest, $meta) = @{YAML::Tiny->read($manfile)}
        or die YAML::Tiny->errstr;
    my $version = qv($meta->{vers});
    die "Unknown version of MANIFEST file\n"
        if $VERSION < $version;
    warn "Loaded manifest for $Manifest->{Package} ($version)\n" if $verbose;
    if($version < $VERSION) {
        warn "Upgrading to a $VERSION manifest\n";
        #FindFiles($Manifest, $_) for qw(Library Modules Conf);
        #die "Package don't match: $Manifest->{Package} vs $Package\n"
        #    if $Manifest->{Package} ne $Package;
        if($version == 1) {
            for my $sec (qw(Library Conf Modules)) {
                my $oarr = $Manifest->{$sec};
                $Manifest->{$sec} = { map +($_ => {}), @$oarr };
            }
        }
    }
    $Package ||= $Manifest->{Package};
    warn "Manifest file will now be named '$Package.gjm'\n" if
        $ManFile ne "$Package.gjm";
    return $Manifest;
}

sub SetOrder {
    my $manref = shift;
    tie my %Manifest, 'Tie::IxHash';
    $Manifest{$_} = $manref->{$_} for
        grep exists($manref->{$_}), @PrefOrder;
    return \%Manifest;
}

sub SaveManifest {
    my $Manifest = SetOrder(shift);
    my $manfile = "$Manifest->{Package}.gjm";
    if(-f $manfile) {
        rename($manfile, "${manfile}.old") or die "Can't create backup: $!\n";
    }
    my $fh = IO::File->new($manfile,'>:utf8')
        or die "Can't create $manfile $!\n";
    print $fh "# This file contains the integrity metadata of the\n",
              "# module, any change here can invalidate it\n#\n";
    if($Signer) {
        print $fh "# Signed by @{[decode('latin1',$Signer->subject)]}\n",
                  "# at @{[scalar(localtime())]}\n#\n";
    }

    print $fh YAML::Tiny::Dump($Manifest),
        "---\nvers: $VERSION\n";
    warn "New $manfile created.\n";
}

sub PackageAll {
    my $Manifest = SetOrder(shift);
    my $ParFile = "$Manifest->{Package}.par";
    my $zip = Archive::Zip->new();
    $zip->addString(
        encode_utf8(YAML::Tiny::Dump($Manifest)),
        'MANIFEST'
    )->desiredCompressionMethod(COMPRESSION_DEFLATED);
    for(keys(%{$Manifest->{Modules}})) {
        if($_ eq '.') {
            $zip->addDirectory('plib');
        } elsif($Manifest->{Modules}{$_}{is_dir}) {
            $zip->addDirectory("plib/$_");
        } else {
            $zip->addFile("plib/$_");
        }
    }
    for(keys(%{$Manifest->{Library}})) {
        if($_ eq '.') {
            $zip->addDirectory("lib/$Manifest->{Package}");
        } elsif($Manifest->{Library}{$_}{is_dir}) {
            $zip->addDirectory("lib/$Manifest->{Package}/$_");
        } else {
            $zip->addFile("lib/$Manifest->{Package}/$_");
        }
    }
    $zip->zipfileComment(encode_utf8(
        $Manifest->{Name} . ' ' .
        qv('v' . $Manifest->{Version}) . ', ' .
        $Manifest->{Attrs}{'©'}{Legal}
    ));
    my $fh = IO::File->new($ParFile, '+>:raw');
    die "Can't write par file: $!\n"
        unless($zip->writeToFileHandle($fh) == AZ_OK);
    warn "New $ParFile created\n";

    my $EOCDO = $zip->_writeEOCDOffset;
    #warn "EOCDO: ",sprintf('0x%08x',$EOCDO),"\n";
}

sub SignPar {
    my $ParFile = shift;
    my $PaqFile = $ParFile;
    $PaqFile =~ s/par$/gjp/;
    my $fh = File::Temp->new();
    {
        my $pf = IO::File->new($ParFile, '<:raw')
            or die "Can't open $ParFile: $!\n";
        my $buff;
        $fh->print($buff) while($pf->read($buff,8192));
    }
    warn "Mangling $ParFile...\n" if $verbose;
    my $EOCDO;
    if(Archive::Zip::Archive->_findEndOfCentralDirectory($fh) == AZ_OK) {
        $EOCDO = $fh->tell();
    } else {
        die "Can't find EOCD in par!\n";
    }
    #warn "EOCDO: ",sprintf('0x%08x',$EOCDO),"\n";
    $fh->seek(0,0);
    $fh->print(pack('V',$EOCDO));
    $fh->seek($EOCDO,0);
    $fh->print('GJ');
    $fh->close();
    warn "PAR Signing...\n";
    my $passin = $ENV{OPENSSL_PASSIN}
        ? "-passin $ENV{OPENSSL_PASSIN}"
        : '';
    system("openssl smime -sign -binary -signer ~/.pki/user.crt -inkey ~/.pki/private.key $passin -nodetach -outform DER -in $fh -out $PaqFile");
    die "Bad signing\n" if $?;
}

sub UpdateManifest {
    my $Manifest = shift;
    for my $sec (qw(Library Modules Conf)) {
        $Origs{$Paths{$sec}} = $Manifest->{$sec};
        FindFiles($Manifest, $sec);
        if(my @k = keys %{$Origs{$Paths{$sec}}}) {
            warn "Deleted files in $sec\n";
            warn "\t$_\n" for sort @k;
        }
    }
    die "Package don't match: '$Manifest->{Package}' vs '$Package'\n"
        if($Manifest->{Package} ne $Package);
    delete $Manifest->{Signature};
    delete $Manifest->{Seal};
    delete $Manifest->{Signer};
    delete $Manifest->{Signed};
    $Manifest->{Path} = File::Spec->rel2abs(File::Spec->curdir());
    return $Manifest;
}

sub InitManifest {
    my $Manifest = {
        Name => 'The name of the module',
        Version => '0.0.0.0',
        Package => '',
        Arch => 'none',
        Build => '$Id: ModMan 4047 2019-06-10 23:01:45Z sog $',
        Attrs => {
          '©' => {
            Author => 'Some smart development group',
            Legal => "© @{[(localtime)[5]+1900]} The smart develpment group",
            Message => 'This module bla, bla, bla',
          },
          '®' => {}
        },
        Path => File::Spec->rel2abs(File::Spec->curdir())
    };
    FindFiles($Manifest, $_) for qw(Library Modules Conf);
    my $module = $Manifest->{Package} = $Package;
    $module =~ s/::/\//g;
    die "Can't found my main module '$module'" unless -f "plib/$module.pm";
    warn "Main module '$Package'\n";
    return $Manifest;
}

sub HashFiles {
    my $Manifest = shift;
    my $section = shift;
    my $check = shift;
    my $dir = $Paths{$section};
    $dir .= "/$Manifest->{Package}" if $dir eq 'lib';
    for my $lib (keys %{$Manifest->{$section}}) {
        my $file = "$dir/$lib";
        next unless -f $file;
        my $fh = IO::File->new($file,'<:raw')
            or die "Library file $lib not found: $!\n";
        my $sha1 = Digest::SHA1->new;
        $sha1->addfile($fh);
        my $actual = $sha1->b64digest;
        if($check) {
            die "Altered $lib! (actual: $actual)\n"
                if $actual ne $Manifest->{$section}{$lib}{sha1sum};
            warn "Checked $file\n";
        } else {
            $Manifest->{$section}{$lib}{sha1sum} = $actual;
        }
    }
}

sub SignManifest {
    my $Manifest = shift;
    my $mode = shift;
    my $ForSign = {
        map +($_ => $Manifest->{$_}),
        grep exists $Manifest->{$_},
        @ForSign
    };
    HashFiles($ForSign, $_, 0) for qw(Modules Library Conf);

    # Load signer private Key
    Crypt::OpenSSL::Common::set_pw_prompt(
        'Enter pass phrase for signer private key: '
    );
    my $MKey;
    until($MKey = eval {
            Crypt::OpenSSL::RSA->new_from_file("$ENV{HOME}/.pki/private.key")
        }) {
        warn "Try again.\n" and next if $@ =~ /bad decrypt/;
        die $@;
    }
    my $sks = $MKey->size * 4; # Session key length
    die "Private key too short!\n" if(!$MKey || $sks < 512);
    # Generate session private key
    my $SKey = Crypt::OpenSSL::RSA->generate_key($sks);
    # Set mode
    if($mode eq 'port') {
        $MKey->use_sha256_hash;
        $SKey->use_sha256_hash;
    } else { # Legacy mode
        $MKey->use_pkcs1_padding;
        $MKey->use_sha1_hash;
        $SKey->use_sha1_hash;
    }
    warn sprintf "SK Size: %d\n", $SKey->size if $verbose;

    # Load signer certificate
    $Signer = Crypt::OpenSSL::X509->new_from_file(
        "$ENV{HOME}/.pki/user.crt"
    );
    # TODO: Check if public key corresponds to private

    # Sign and save
    my $signed = [ sort keys %{$ForSign} ];
    warn "Signing keys: @$signed\n" if $verbose;
    my $as = $SKey->sign(CannonForm($ForSign->{Attrs}, $mode));
    warn sprintf "Attrs signature length: %d\n", length($as) if $verbose;
    my $gs = $MKey->sign(CannonForm($ForSign, $mode));
    warn sprintf "General signature length: %d\n", length($gs) if $verbose;
    $ForSign->{Signature} = (!$mode ? '' : "$mode:") . unpack 'H*', $as . $gs;

    $ForSign->{Signed} = $signed;
    $ForSign->{Signer} = MIME::Base64::encode(
        $Signer->as_string(FORMAT_ASN1),''
    );

    # Save Encrypted session Key
    $ForSign->{Seal} = unpack 'H*', $MKey->private_encrypt(
        ($SKey->get_key_parameters)[0]->to_bin
    );

    # Add extra
    $ForSign->{$_} = $Manifest->{$_} for
        grep !exists $ForSign->{$_}, keys %{$Manifest};

    return $ForSign;
}

sub _trim {
    $_[0] =~ s/\$H\s*=\s*//;
    return $_[0];
}

sub CheckManifest {
    my $Manifest = shift;
    my $self = { _tainted => 1, _signverified => 1};
    my ($seal, $SKp, $signature );
    my $mode = '';
    eval {
        if($Manifest->{Signature} =~ s/^(\w{4,8})://) {
            $mode = $1;
            warn "Mode: $mode\n";
        }
        #warn "Sig: ",$Manifest->{Signature},"\n";
        $self->{signer} = Crypt::OpenSSL::X509->new_from_string(
            MIME::Base64::decode($Manifest->{Signer}), FORMAT_ASN1
        );
        my $pk = Crypt::OpenSSL::RSA->new_public_key($self->{signer}->pubkey);
        if($mode eq 'port') {
            $pk->use_sha256_hash;
        } else {
            $pk->use_pkcs1_padding;
            $pk->use_sha1_hash;
        }
        my $ForSign = { map +($_ => $Manifest->{$_}), @{$Manifest->{Signed}} };
        my $CFFS = CannonForm($ForSign, $mode);
        #warn "CFFS: $CFFS\n";
        ($self->{Attrs}, $self->{Signed}) = ($Manifest->{Attrs}, $ForSign) if
            $signature = pack 'H*', $Manifest->{Signature} and
            $SKp = $pk->public_decrypt(pack 'H*', $Manifest->{Seal}) and
            #warn unpack('H*', $SKp), "\n" and
            $self->{SK} = Crypt::OpenSSL::RSA->new_key_from_parameters(
                Crypt::OpenSSL::Bignum->new_from_bin($SKp),
                Crypt::OpenSSL::Bignum->new_from_decimal(0x10001)
            ) and
            ($mode ? $self->{SK}->use_sha256_hash : $self->{SK}->use_sha1_hash),
            warn "Ksize: ",$self->{SK}->size,"\n" and
            $self->{SK}->verify(CannonForm($Manifest->{Attrs}, $mode),
                substr($signature, 0, $self->{SK}->size, '')
            ) and warn "AOK\n" and
            $pk->verify($CFFS, $signature) and warn "ROK\n";
        # Check hashes
        HashFiles($ForSign, $_, 1) for qw(Modules Library Conf);
    };
    die $@ if $@;
    $self->{_tainted} = 0 if $self->{Attrs} && $self->{Signed};
    $self->{_signverified}++ unless $self->{_tainted};
    warn "SV: $self->{_signverified}\n";
}

my $nVersion;
our %incs = qw(M 0 m 1 p 2 f 3);
sub BumpVersion {
    my $Manifest = shift;
    my $ov = qv($Manifest->{Version});
    if($nVersion =~ /^s/) {
        print $ov->normal . "\n";
        exit 0;
    }
    if($nVersion =~ /\+([Mmpf])$/) {
        my $inc = $incs{$1};
        $ov->{version}[$inc]++;
        if(++$inc < 4) { $ov->{version}[$_] = 0 for ($inc .. 3) }
        $verbose = 1;
        $nVersion = join('.',@{$ov->{version}});
    } else {
        die "Not a valid version '$nVersion'\n" unless version::is_strict('v'.$nVersion);
    }
    $Manifest->{Version} = $nVersion;
    # TODO
    warn "Now $Manifest->{Package} at v$Manifest->{Version}\n" if $verbose;
    return $Manifest;
}

sub usage {
    print STDERR <<EOF;

ModMan version $VERSION

Usage: ModMan [options]

Utility for GranJefe's modules MANIFEST handling

Options:
  -V, --Version          Print version and exit
  -v, --verbose          Enable verbose output
  -n, --name=STRING      Specify package name
  -I                     Initialize a new manifest
  -S                     Sign the manifest
  -P                     Create a package (.par), implies -S
  -M                     Create a signed package (.gjp), implies -S -P
  --port                 Use port mode for signing (SHA256)
  --keep                 Keep old files (e.g., .gjm.old)
  -h, --help             Display this help and exit
  --orig                 Do not update the manifest
  -C                     Check the manifest signature
  -b, --bump=STRING      Bump version (e.g., +M, +m, +p, +f or specific version)

Examples:
  ModMan -V              # Show version
  ModMan -I              # Initialize manifest
  ModMan -S              # Sign manifest
  ModMan -P              # Create package
  ModMan -M              # Create signed package
  ModMan -C              # Check signature
  ModMan --bump=+m       # Bump minor version

EOF
    exit shift;
}

$ManFile = glob '*.gjm';
our $MR;
my $update = 1 if $ManFile;

{ # Options processing
    my $help;
    my $sign = 0;
    my $smode = '';
    my $gpar = 0;
    my $gmod = 0;
    my $keep = 0;
    my $check = 0;
    GetOptions(
        'Version' => sub { print "ModMan version $VERSION\n"; exit 0 },
        'verbose' => \$verbose,
        'name=s' => \$Package,
        'I' => sub { $MR = InitManifest; $update = 0; },
        'S' => \$sign,
        'P' => sub { $gpar = 1; $sign = 1 },
        'M' => sub { $gpar = 1; $sign = 1; $gmod = 1 },
        'port' => sub { $smode = 'port' },
        'keep' => \$keep,
        'help|?' => \$help,
        'orig' => sub { $update = 0 },
        'C' => \$check,
        'bump=s' => \$nVersion,
    ) or usage(1);
    usage(0) if $help;

    if($ManFile && !$MR) {
        $MR = LoadManifest($ManFile);
    }
    die "No manifest found nor -I\n" unless $MR;
    if($check) {
        CheckManifest($MR);
        exit 0;
    }
    $MR = BumpVersion($MR) if $nVersion;
    $MR = UpdateManifest($MR) if $update;
    $MR = SignManifest($MR, $smode) if $sign;
    PackageAll($MR) if $gpar;
    if($gmod) {
        SignPar("$MR->{Package}.par");
        unlink "$MR->{Package}.par" unless $keep;
    }
    SaveManifest($MR) unless $gpar;
    unlink "$MR->{Package}.gjm.old" unless $keep;
}

=pod

=encoding utf8

=head1 NAME

ModMan - An utility for GranJefe's modules MANIFEST handling

=head1 SYNOPSIS

ModMan [options]

=head1 DESCRIPTION

ModMan is a utility script for managing MANIFEST files of GranJefe modules.
It can initialize, update, sign, package, and verify module manifests.

=head1 OPTIONS

=over 4

=item B<-V, --Version>

Print the version of ModMan and exit.

=item B<-v, --verbose>

Enable verbose output.

=item B<-n, --name=s>

Specify the package name.

=item B<-I>

Initialize a new manifest.

=item B<-S>

Sign the manifest.

=item B<-P>

Create a package (.par file), implies -S.

=item B<-M>

Create a signed package (.gjp file), implies -S and -P.

=item B<--port>

Use port mode for signing (SHA256 instead of SHA1).

=item B<--keep>

Keep old files (e.g., .gjm.old).

=item B<-h, --help>

Display help and exit.

=item B<--orig>

Do not update the manifest.

=item B<-C>

Check the manifest signature.

=item B<-b, --bump=s>

Bump the version (e.g., +M for major, +m for minor).

=back

=head1 AUTHOR

(c) 2015-2025 Matías Software Group

=head1 VERSION

Version 3.0.2

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015-2025 Matías Software Group. All rights reserved.

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

=cut
