#!/usr/bin/env perl

use strict;

use warnings FATAL => 'all';

use integer;

use Data::Dumper;

use Getopt::Long qw(:config no_ignore_case);

use File::Copy;

use Text::Wrap;

use File::Basename;

use Cwd;

use POSIX qw(strftime);

sub blab {

    print 'debmaker: ', @_, "\n";

}

sub warning {

    blab 'WARNING: ', @_;

    sleep 2;

}

sub fatal {

    blab 'FATAL: ', @_;

    exit 1;

}

sub my_chdir {

    my ($path) = @_;

    chdir $path or fatal "Can't chdir() to `$path': $!";

}

sub my_symlink {

    my ($src, $dst) = @_;

    symlink $src, $dst

        or fatal "Can't create symlink `$src' -> `$dst': $!"

}

sub my_hardlink {

    my ($src, $dst) = @_;

    # For harlink creating target file must be accessible:

    my $pwd = getcwd;

    my $dir = dirname $dst;

    my_chdir $dir;

    link $src, $dst

        or fatal "Can't create hardlink `$src' -> `$dst': $!";

    my_chdir $pwd;

}

sub my_copy {

    my ($src, $dst) = @_;

    copy $src, $dst

        or fatal "Can't copy `$src' to `$dst': $!";

}

sub my_chown {

    my ($u, $g, $path) = @_;

    my $uid = getpwnam $u;

    my $gid = getgrnam $g;

    chown $uid, $gid, $path

         or fatal "Can't chown ($u.$g) `$path': $!";

}

sub my_chmod {

    my ($mode, $path) = @_;

    chmod oct($mode), $path

        or fatal "Can't chmod ($mode) `$path': $!";

}

sub my_mkdir {

    my ($path, $mode) = @_;

    if (defined $mode) {

        mkdir $path, oct($mode)

            or fatal "Can't create dir `$path' with mode `$mode': $!";

    } else{

        mkdir $path

            or fatal "Can't create dir `$path': $!";

    }

}

sub uniq {

    my ($array_ref) = @_;

    my %hash = map { $_, 1 } @$array_ref;

    @$array_ref = keys %hash;

}

sub shell_exec {

    my ($cmd) = @_;

    blab "executing `$cmd'";

    system($cmd);

    if ($? == -1) {

        fatal "failed to execute: $!";

    } elsif ($? & 127) {

        fatal (printf "child died with signal %d, %s coredump",

            ($? & 127),  ($? & 128) ? 'with' : 'without')

    } else {

        my $rc = $? >> 8;

        if ($rc != 0) {

            warning "child exited with value $rc";

        }

    }

}

sub get_command_line {

    my ($map_ref, $hash_ref) = @_;

    my $res = '';

    foreach my $k (keys %$map_ref) {

        $res .= " $$map_ref{$k} '$$hash_ref{$k}'" if exists $$hash_ref{$k};

    }

    return $res;

}

sub write_file {

    my ($filename, $content) = @_;

    blab "Writing file `$filename'";

    if (open FD, '>', $filename) {

        print FD $content;

        close FD;

    } else {

        fatal "Can't write to file `$filename': $!"

    }

}

sub write_script {

    my ($filename, $content) = @_;

    $content = "#!/bin/sh\nset -e\n$content";

    write_file $filename, $content;

    my_chmod '0555', $filename;

}

sub get_output {

    my ($cmd) = @_;

    if (open OUT, "$cmd |") {

        my @lines = <OUT>;

        close OUT;

        chomp @lines;

        warning "Empty output from `$cmd'" unless @lines;

        return \@lines;

    } else {

        fatal "Can't execute `$cmd': $!"

    }

}

sub get_output_line {

    return (@{get_output @_})[0];

}

sub trim {

    # works with refs:

    $$_ =~ s/^\s*(.*)\s*$/$1/ foreach @_;

}

# Expected input for @PROTO_DIRS:

# -d /root/oi-build/components/elinks/build/prototype/i386/mangled

# -d /root/oi-build/components/elinks/build/prototype/i386

# -d .

# -d /root/oi-build/components/elinks

# -d elinks-0.11.7

# (like debian/tmp)

my @PROTO_DIRS = ();

# Where to create debs prototypes

# (like debian/pkg-name)

my $DEBS_DIR = '';

# If true, will use manifests from command line

# to resolve dependencies:

my $BOOTSTRAP = 0;

my $MAINTAINER = 'Nexenta Systems <[email protected]>';

my $VERSION = '0.0.0';

my $ARCH = 'solaris-i386';

my $SOURCE = 'xxx'; # only for *.changes

my $DISTRIB = 'unstable'; # only for *.changes

# Mapping file => IPS FMRI, filled on bootstrap:

my %PATHS = ();

GetOptions (

    'd=s' => \@PROTO_DIRS,

    'D=s' => \$DEBS_DIR,

    'V=s' => \$VERSION,

    'A=s' => \$ARCH,

    'M=s' => \$MAINTAINER,

    'S=s' => \$SOURCE,

    'N=s' => \$DISTRIB,

    'bootstrap!' => \$BOOTSTRAP,

    'help|h' => sub {usage()},

) or usage();

sub usage {

    print <<USAGE;

Usage: $0 [options] -D <output dir> -d <proto dir> [-d <proto dir> ... ] manifests

Options:

    -d <proto dir>     where to find files (like debian/tmp)

    -D <output dir>    where to create package structure and debs,

                       <output dir>/pkg-name and

                       <output dir>/pkg-name*.deb will be created

    -V <version>       version of created packages (default is `$VERSION'),

                       may be 'ips' to use the same as for IPS system.

    -A <architecture>  package architecture, default is `$ARCH'

    -S <source name>   package source name to make reprepro happy

                       with *.changes files, default is `$SOURCE'

    -N <dist name>     distribution  name to make reprepro happy

                       with *.changes files, default is `$DISTRIB'

    -M <maintainer>    Package maintainer - mandatory for debs,

                       default is `$MAINTAINER'

    --bootstrap        Search for dependencies within listed manifests,

                       not within installed system (for bootstraping)

                       ** not implemented yet **

    -h, --help         Show help info

USAGE

    exit 1;

}

sub parse_keys {

    my ($line) = @_;

    # parse:

    # name=pkg.summary value="advanced text-mode WWW browser"

    # into:

    # 'name' => pkg.summary

    # 'value' => "advanced text-mode WWW browser"

    # http://stackoverflow.com/questions/168171/regular-expression-for-parsing-name-value-pairs

    # TODO: add support for dublicates: dir=dir1 dir=dir2

    my %pairs = ($line =~ m/((?:\\.|[^= ]+)*)=("(?:\\.|[^"\\]+)*"|(?:\\.|[^ "\\]+)*)/g);

    foreach my $k (keys %pairs) {

        $pairs{$k} =~ s/^"(.+)"$/$1/;

    }

    return \%pairs;

}

sub read_manifest {

    my ($filename) = @_;

    my %data = ();

    $data{'dir'} = [];

    $data{'file'} = [];

    $data{'link'} = [];

    $data{'hardlink'} = [];

    $data{'depend'} = [];

    $data{'legacy'} = [];

    $data{'group'} = [];

    $data{'user'} = [];

    $data{'license'} = [];

    if (open IN, '<', $filename) {

        while (<IN>) {

            study; chomp;

            if (/^set +/) {

                my $pairs = parse_keys $_;

                $data{$$pairs{'name'}} = $$pairs{'value'};

            } elsif (/^dir +/) {

                my $pairs = parse_keys $_;

                push @{$data{'dir'}}, $pairs;

            } elsif (/^file +(\S+) +/) {

                my $maybe_src = $1;

                my $pairs = parse_keys $_;

                $$pairs{'src'} = $maybe_src if $maybe_src ne 'NOHASH';

                push @{$data{'file'}}, $pairs;

            } elsif (/^link +/) {

                my $pairs = parse_keys $_;

                push @{$data{'link'}}, $pairs;

            } elsif (/^hardlink +/) {

                my $pairs = parse_keys $_;

                push @{$data{'hardlink'}}, $pairs;

            } elsif (/^depend +/) {

                my $pairs = parse_keys $_;

                push @{$data{'depend'}}, $pairs;

            } elsif (/^legacy +/) {

                my $pairs = parse_keys $_;

                push @{$data{'legacy'}}, $pairs;

            } elsif (/^group +/) {

                my $pairs = parse_keys $_;

                push @{$data{'group'}}, $pairs;

            } elsif (/^user +/) {

                my $pairs = parse_keys $_;

                push @{$data{'user'}}, $pairs;

            } elsif (/^license +(\S+) +/) {

                my $maybe_src = $1;

                my $pairs = parse_keys $_;

                $$pairs{'src'} = $maybe_src if $maybe_src !~ /=/;

                push @{$data{'license'}}, $pairs;

            } elsif (/^\s*$/) {

                # Skip empty lines

            } elsif (/^\s*#/) {

                # Skip comments

            } else {

                warning "Unknown action: `$_'";

            }

            # TODO:

            # user - to create users (in postinstall?)

            # restart_fmri - restart SMF

        }

        close IN;

        return \%data;

    } else {

        fatal "Can't open `$filename': $!";

    }

}

sub get_debpkg_names {

#    pkg:/web/browser/[email protected],5.11-1.1

# => web-browser-elinks

#        browser-elinks

#                elinks

    my ($fmri) = @_;

    my @names = ();

    if ($fmri =~ m,^(?:pkg:/)?([^@]+)(?:@.+)?$,) {

        my $pkg = $1;

        my @parts = split /\//, $pkg;

        while (@parts) {

            push @names, (join '-', @parts);

            shift @parts;

        }

        return @names;

    } else {

        fatal "Can't parse FMRI to get dpkg name: `$fmri'";

    }

}

sub get_ips_version {

#    pkg:/web/browser/[email protected],5.11-1.1

# => 0.11.5-5.11-1.1

    my ($fmri) = @_;

    if ($fmri =~ m,^(?:pkg:/)?[^@]+@(.+)$,) {

        my $ips = $1;

        $ips =~ s/[,:]/-/g;

        return $ips;

    } else {

        fatal "Can't parse FMRI to get IPS version: `$fmri'";

    }

}

sub get_pkg_section {

    my ($pkgname) = @_;

    if ($pkgname =~ m,^([^-@]+)-.*,) {

        return (split /-/, $pkgname)[0];

    } elsif ($pkgname =~ m,^pkg:/([^/]+)/.*,) {

        return $1;

    } else {

        fatal "Can't get section for package `$pkgname'"

    }

}

sub get_dir_size {

    my ($path) = @_;

    # We get size just after files are copied

    # and need sync() to get proper sizes:

    my $out = get_output("sync && du -sk $path | cut -f 1");

    return $$out[0];

}

sub find_pkgs_with_paths {

    my @paths = @_;

    s,^/+,,g foreach @paths;

    my $dpkg = get_output('dpkg-query --search -- ' . join(' ',  @paths) . ' | cut -d: -f1');

    return $dpkg;

}

sub guess_required_deps {

    my ($path) = @_;

    my $elfs = get_output("find $path -type f -exec file {} \\; | grep ELF | cut -d: -f1");

    my @deps = ();

    if (@$elfs) {

    #   my $libs = get_output('ldd ' . join(' ', @$elfs) . ' | grep "=>"');

        my $libs = get_output('elfdump -d ' . join(' ', @$elfs) . ' | grep NEEDED | awk \'{print $4}\'');

        uniq $libs;

        my $pkgs = find_pkgs_with_paths @$libs;

        push @deps, @$pkgs;

    }

    return \@deps;

}

if (!$DEBS_DIR) {

    fatal "Output dir is not set. Use -D option."

}

if (! -d $DEBS_DIR) {

    fatal "Not a directory: `$DEBS_DIR'"

}

# Walk through all manifests

# and collect files, symlinks, hardlink

# mapping them to package names:

if ($BOOTSTRAP) {

    blab "Bootstrap: collecting paths ...";

    foreach my $manifest_file (@ARGV) {

        my $manifest_data = read_manifest $manifest_file;

        my $fmri = $$manifest_data{'pkg.fmri'};

        my @items = ();

        if (my @files = @{$$manifest_data{'file'}}) {

            push @items, @files;

        }

        if (my @symlinks = @{$$manifest_data{'link'}}) {

            push @items, @symlinks;

        }

        if (my @hardlinks = @{$$manifest_data{'hardlink'}}) {

            push @items, @hardlinks;

        }

        foreach my $item (@items) {

            my $path = $$item{'path'};

            if (exists $PATHS{$path}) {

                warning "`$path' already present in `$PATHS{$path}' and now found in `$fmri' (manifest `$manifest_file')"

            } else {

                $PATHS{$path} = $fmri;

            }

        }

    }

    blab 'Bootstrap: ' . (keys %PATHS) . ' known paths'

}

my %changes = ();

$changes{'Date'} = strftime '%a, %d %b %Y %T %z', localtime; # Sat, 11 Jun 2011 17:08:17 +0200

$changes{'Architecture'} = $ARCH;

$changes{'Format'} = '1.8';

$changes{'Maintainer'} = $MAINTAINER;

$changes{'Source'} = lc $SOURCE;

$changes{'Version'} = $VERSION;

$changes{'Distribution'} = $DISTRIB;

$changes{'Changes'} = 'Everything has changed';

$changes{'Description'} = '';

$changes{'Checksums-Sha1'} = '';

$changes{'Checksums-Sha256'} = '';

$changes{'Files'} = '';

$changes{'Binary'} = '';

foreach my $manifest_file (@ARGV) {

    blab "****** Manifest: `$manifest_file'";

    my $manifest_data = read_manifest $manifest_file;

    my @provides = get_debpkg_names $$manifest_data{'pkg.fmri'};

    my $debname = shift @provides; # main name (web-browser-elinks)

    my $debsection = get_pkg_section $debname;

    my $debpriority = exists $$manifest_data{'pkg.priority'} ?  $$manifest_data{'pkg.priority'} : 'optional';

    foreach my $l (@{$$manifest_data{'legacy'}}) {

        push @provides, $$l{'pkg'};

    }

    my $provides_str = join(', ', @provides);

    my $pkgdir = "$DEBS_DIR/$debname";

    blab "Main package name: $debname";

    blab "Other names: $provides_str";

    my $ipsversion = get_ips_version $$manifest_data{'pkg.fmri'};

    my $debversion = undef;

    if ($VERSION eq 'ips') {

        blab "Using IPS version scheme: $ipsversion";

        $debversion = $ipsversion;

    } else {

        blab "Using given version: $VERSION";

        $debversion = $VERSION;

    }

    # Make sure to work with empty tree:

    # mkdir will fail if dir exists

    my_mkdir $pkgdir;

    # Believe that dirs are listed in proper order:

    # usr, usr/bin, etc

    if (my @dirs = @{$$manifest_data{'dir'}}) {

        blab "Making dirs ...";

        foreach my $dir (@dirs) {

            my $dir_name = "$pkgdir/$$dir{'path'}";

            my_mkdir $dir_name, $$dir{'mode'};

            my_chown $$dir{'owner'}, $$dir{'group'}, $dir_name;

        }

    }

    my @conffiles = ();

    if (my @files = @{$$manifest_data{'file'}}) {

        blab "Copying files ...";

        foreach my $file (@files) {

            my $dst = "$pkgdir/$$file{'path'}";

            my $src = exists $$file{'src'} ? $$file{'src'} : $$file{'path'};

            # find $src in @PROTO_DIRS:

            my $src_dir = undef;

            foreach my $d (@PROTO_DIRS) {

                # http://stackoverflow.com/questions/2238576/what-is-the-default-scope-of-foreach-loop-in-perl

                $src_dir = $d;

                last if -f "$src_dir/$src";

            }

            fatal "file `$src' not found in ", join(', ', @PROTO_DIRS)

                unless $src_dir;

            $src = "$src_dir/$src";

            my_copy $src, $dst;

            my_chown $$file{'owner'}, $$file{'group'}, $dst;

            my_chmod $$file{'mode'}, $dst;

            push @conffiles, $$file{'path'} if exists $$file{'preserve'};

        }

    }

    if (my @hardlinks = @{$$manifest_data{'hardlink'}}) {

        blab "Creating hardlinks ...";

        foreach my $link (@hardlinks) {

            my_hardlink $$link{'target'}, "$pkgdir/$$link{'path'}";

        }

    }

    if (my @symlinks = @{$$manifest_data{'link'}}) {

        blab "Creating symlinks ...";

        foreach my $link (@symlinks) {

            my_symlink $$link{'target'}, "$pkgdir/$$link{'path'}";

        }

    }

    if (my @license = @{$$manifest_data{'license'}}) {

        # FIXME: install in usr/share/doc/<pkg>/copyright

        # what are the owner, permissions?

        # multiple licenses?

    }

    my $installed_size = get_dir_size($pkgdir);

    my @depends = ();

    my @predepends = ();

    my @recommends = ();

    my @conflicts = ();

    blab "Getting dependencies ...";

    foreach my $dep (@{$$manifest_data{'depend'}}) {

        if ($$dep{'fmri'} ne '__TBD') {

            my $dep_pkg = (get_debpkg_names($$dep{'fmri'}))[0];

            blab "Dependency: $dep_pkg ($$dep{'type'})";

            push @depends,    $dep_pkg if $$dep{'type'} eq 'require';

            push @predepends, $dep_pkg if $$dep{'type'} eq 'origin';

            # push @recommends, $dep_pkg if $$dep{'type'} eq 'optional';

            push @conflicts,  $dep_pkg if $$dep{'type'} eq 'exclude';

        }

    }

    push @depends, @{guess_required_deps($pkgdir)};