#!/usr/bin/perl

use strict;
use warnings;
use Cwd;
use Youri::Package::RPM;
use Youri::Package::RPM::Builder;
use Git;
use YAML::XS;
use HTTP::SimpleLinkChecker qw(check_link);
use Digest::SHA1;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use HTTP::Status qw(status_message);
use Config::IniFiles;
use Net::Netrc;
use Term::ReadKey qw(ReadMode);
use File::Remove qw(remove);
use Getopt::Std qw(getopts);
use List::MoreUtils qw(first_index indexes);
use ABF;

=head1 NAME

bfc - ABF command-line client

=head1 SYNOPSIS

I<bfc> <action> [options]

=head2 Actions:

=over 12

=item b[uild]

build package locally

=item can[cel]

cancel builds

=item c[lone]

clone project to local directory

=item f[etch]

fetch new sources from upstream

=item g[et]

get all sources for local build

=item i[nfo]

display info about ABF project

=item pub[lish]

publish built packages

=item p[ush]

push local changes to ABF

=item rej[ect]

reject packages publication

=item st[atus]

display status of recent builds on ABF

=item s[u]b[mit]

submit project build to ABF (experimental)

=item s[ync]

sync sources and patches

=item up[load]

upload sources to file store

=back

=head1 DESCRIPTION

Build farm client is an alternative ABF client. It helps managing git repos
and ABF tasks.

=cut

our $config = Config::IniFiles->new( -file => "/etc/bfc.conf" );
if (-r "$ENV{HOME}/.bfc.conf") {
    $config = Config::IniFiles->new(
        -file   => "$ENV{HOME}/.bfc.conf",
        -import => $config
    );
}

my $action = shift @ARGV || "";

for ($action) {
    /^b(uild)?$/                ?   build()         :
    /^ca?n(cel)?$/              ?   cancel()        :
    /^c(lean)?[-_]?t(ree)?$/    ?   cleantree()     :
    /^c(lone)?$/                ?   clone()         :
    /^f(etch)?$/                ?   fetch()         :
    /^g(et)?$/                  ?   get()           :
    /^i(nfo)?$/                 ?   info()          :
    /^pub(lish)?$/              ?   publish()       :
    /^p(ush)?$/                 ?   pushcmd()       :
    /^rej(ect)?$/               ?   reject()        :
    /^st(atus)?$/               ?   status()        :
    /^su?b(mit)?$/              ?   submit()        :
    /^s(ync)?$/                 ?   sync()          :
    /^up(load)?$/               ?   upload(@ARGV)   :
    die "wrong syntax\n";
}

=head1 ACTIONS

=head2 build

Build a package in local system. Spec file and sources will be taken from
current directory, but all other files will be located under I<$HOME/rpmbuild/>
(or in other directories specified in rpm macros).

If source files are missing in workind directory, they are downloaded from File
Store (if available) or from upstream.

=head3 Options:

=over 4

=item -a

Build binary and source packages (default).

=item -b

Build binary packages.

=item -p

Execute the "%prep" stage from the spec file.

=item -c

Do the "%build" stage from the spec file.

=item -i

Do the "%install" stage from  the  spec  file.

=item -l

List check - check that files specified in "%files" section(s) exists.

=item -s

Build just the source package.

=item -o

Execute only the specified stage skipping all previous steps.

=back

=cut

sub build {
    get();
    my %opts;
    my @stages = ('a', 'b', 'c', 'i', 'l', 'p', 's');
    getopts(join('', @stages, 'o'), \%opts);
    my %buildopts;
    foreach (@stages) {
        if ($opts{$_}) {
            if ($buildopts{stage}) {
                die "options -" .
                    $buildopts{stage} .
                    " and -" .
                    $_ .
                    " are mutually exclusive\n";
            } else {
                $buildopts{stage} = $_;
            }
        }
    }
    $buildopts{stage} = 'a' unless $buildopts{stage};
    $buildopts{options} = '--short-circuit' if $opts{o};
    my $builder = Youri::Package::RPM::Builder->new(
        sourcedir   => cwd(),
        verbose     => 2
    );
    eval { $builder->build(find_spec(), %buildopts) };
}

=head2 cancel

I<bfc> I<cancel> <ID>...

Cancel buildlists with specified IDs.

=cut

sub cancel {
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
    );
    foreach (@ARGV) {
        if (/^\d+$/) {
            my $bl = $abf->buildlist(id => $_);
            my $result = eval { $bl->cancel() };
            if ($result->{is_canceled}) {
                print "Build $_ canceled\n";
            } else {
                warn "Error canceling build $_: $result->{message}\n";
            }
        } else {
            warn "Wrong build ID $_\n";
        }
    }
}

=head2 cleantree

Clean git tree from binary files, e.g. tarballs. This command should not be
run directly but by B<git filter-branch>:

    git filter-branch --tree-filter 'bfc cleantree' -- --all

It finds binary files in git tree, add them to I<.abf.yml>, uploads to file
store and then removes. Before running this command ensure that you have
fetched all remote branches. Be very careful because pushing your changes
to remote repository will overwrite any commits added after your last fetch.
Use this two commands for push:

    git push --force --all
    git push --force --tags

=cut

sub cleantree {
    my @trackedfiles = <*>;
    my $abfyml = eval{ read_abfyml() };
    my $fs_baseurl = fs_baseurl();

    if ($abfyml) {
        foreach my $file (keys %{$abfyml->{sources}}) {
            if ($file ~~ @trackedfiles) {
                unless (checkfilestore($abfyml->{sources}{$file})) {
                    fs_upload($file);
                }
            }
        }
    }

    foreach my $file (@trackedfiles) {
        unless ($abfyml->{sources}{$file}) {
            unless (-T $file) {
                my $ctx = Digest::SHA1->new();
                open(my $FILE, "<", $file);
                $ctx->addfile($FILE);
                $abfyml->{sources}{$file} = $ctx->hexdigest();
                unless (checkfilestore($abfyml->{sources}{$file})) {
                    fs_upload($file);
                }
                remove $file;
            }
        }
    }

    YAML::XS::DumpFile('.abf.yml', $abfyml);
}

=head2 clone

I<bfc> I<clone> <project> [options]

Clone ABF git repository to local directory. <project> can be specified as
I<owner>/I<name> or I<name> (default owner will be used). See L<git-clone> for
options.

=cut

sub clone {
    my $projname = shift @ARGV;
    $projname = fullname($projname);
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
    );
    my $project = $abf->project(fullname => $projname);
    Git::command_noisy('clone', $project->git_url(), @ARGV);
}

=head2 fetch

Fetch sources from upstream. Only new sources that are not available locally
nor at file store are downloaded.

=cut

sub fetch {
    my $spec = shift || init_spec();
    my $abfyml = shift || read_abfyml();

    my @sourceurls = ($spec->sources_url(), $spec->icon_url());
    @sourceurls = map { m/^(https?|ftp):/ ? $_ : () } @sourceurls;

    foreach (@sourceurls) {
        m([^/]+$);
        unless (-f $& or
            $abfyml->{sources}{$&} and checkfilestore($abfyml->{sources}{$&}))
        {
            print "downloading $&\n";
            download($_, $&);
        }
    }
}

=head2 get

Get all sources to perform local build. If source file is available at file
store it is downloaded from there, otherwise URL specified in spec file
is used.

=cut

sub get {
    my $spec = init_spec();
    my $abfyml = read_abfyml();
    my @sourceurls = ($spec->sources_url(), $spec->icon_url());
    my $baseurl = $config->val('file-store', 'baseurl');

    foreach (@sourceurls) {
        m([^/]+$);
        unless (-f $&) {
            print "downloading $&\n";
            if (my $sha1 = $abfyml->{sources}{$&}) {
                download("$baseurl/download/$sha1", $&);
            } else {
                download($_, $&);
            }
        }
    }
}

=head2 info

I<bfc> I<info> <project>

Show information about specified ABF project. Project can be specified as
<owner>/<name> or <name> (default owner will be used).

=cut

sub info {
    my $fullname = fullname(shift @ARGV);
    die "Usage: bfc info <owner>/<project>" unless $fullname && $fullname =~ m|^[^/]+/[^/]+$|;
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
    );
    my $project = $abf->project(fullname => $fullname);
    binmode(STDOUT,':utf8');
    print "Project:\t\t" . $project->name() . "\n";
    print "Owned by " . lcfirst($project->owner('type')) . ":\t\t" . $project->owner('name') . "\n";
    print "Maintained by " . lcfirst($project->maintainer('type')) . ":\t" . $project->maintainer('name') . "\n";
    eval { print "Package:\t\t" . ($project->is_package() ? 'yes' : 'no') . "\n" };
    print "Created:\t\t" . localtime($project->created_at()) . "\n";
    print "Last updated:\t\t" . localtime($project->updated_at()) . "\n";
    print "Git URL:\t\t" . $project->git_url() . "\n";
    print "Platforms:\t\t";
    print join ', ', @{$project->repositories('platform', 'name')};
    print "\n";
    eval { print "\nDescription:\n" . $project->description() . "\n" };
}

=head2 publish

I<bfc> I<publish> <ID>...

Publish buildlists with specified IDs.

=cut

sub publish {
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
    );
    foreach (@ARGV) {
        if (/^\d+$/) {
            my $bl = $abf->buildlist(id => $_);
            my $result = eval { $bl->publish() };
            if ($result->{is_published}) {
                print "Build $_ published\n";
            } else {
                warn "Error publishing build $_: $result->{message}\n";
            }
        } else {
            warn "Wrong build ID $_\n";
        }
    }
}

=head2 push

Push all commited changes to origin (like git push) and upload all files
specified in I<.abf.yml> to file store. If needed, new source files are
downloaded, I<.abf.yml> and git index synced with specfile, and all changes
committed.

=cut

sub pushcmd {
    my $specfile = find_spec();
    my $spec = init_spec($specfile);
    my $git = Git->repository(cwd())
        or die "Not in the git working directory\n";

    sync($git);
    $git->command_noisy('commit', '-a')
        if $git->command('status', '--short', '--untracked-files=no');
    $git->command('push', @ARGV);
    upload();
}

=head2 reject

I<bfc> I<reject> <ID>...

Reject buildlists with specified IDs.

=cut

sub reject {
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
    );
    foreach (@ARGV) {
        if (/^\d+$/) {
            my $bl = $abf->buildlist(id => $_);
            my $result = eval { $bl->reject() };
            if ($result->{is_rejected}) {
                print "Build $_ rejected\n";
            } else {
                warn "Error rejecting build $_: $result->{message}\n";
            }
        } else {
            warn "Wrong build ID $_\n";
        }
    }
}

=head2 status

I<bfc> I<status> [<ID>...]

Show status of specified builds or last builds submitted by current user.

=cut

sub status {
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
                    );
    if (@ARGV) {
        foreach (@ARGV) {
            if (/^\d+$/) {
                print_buildlist($abf->buildlist(id => $_));
            } else {
                warn "Invalid build ID $_\n";
            }
        }
    } else {
        foreach ($abf->buildlists) {
            print_buildlist($_);
        }
    }
}

=head2 submit

Submit project build to ABF. This is an experimental feature, its behavior may
change in future releases. It does not work with personal platforms ATM.

=head3 options

=over 4

=item -a

Automatically publish packages.

=item -p <platform>

Specify target platform. If it is not specified explicitly, bfc will try to
use platform with the same name as current git branch, if it exists, or the
one specified in configuration file as default.

=item -r <revision>

Git revision (commit hash, branch or tag). If not specified, the current
branch will be used.

=item -s <severity>

Update severity. If not specified, the default value from configuration file
will be used.

=back

=cut

sub submit {
    my %opts;
    getopts('ap:r:s:', \%opts);
    my $git = Git->repository(cwd())
        or die "Not in the git working directory\n";

    # git revision
    my $gitrev = $opts{r} || '@{0}';
    $gitrev = $git->command('rev-parse', $gitrev);
    chomp $gitrev;

    # update severity
    my $severity = $opts{s} || $config->val('defaults', 'update_severity') ||
        die 'update severity not specified';

    # find project fullname
    my $fullname = $git->config('remote.origin.url');
    ($fullname) = $fullname =~ m|/(\w+/\w+)\.git$|;
    my $abf = ABF->new( baseurl     => $config->val('abf', 'baseurl'),
                        login       => abf_username(),
                        password    => abf_password()
    );
    my $project = $abf->project(fullname => $fullname);

    # guess target platform and repository
    my @platforms = @{$project->repositories('platform', 'name')};
    my ($branch) = $git->command('branch', '--no-color', '--no-column', '--no-abbrev') =~ /^\*\s(.*)$/m;
    my $repoidx;
    if ($opts{p}) {
        $repoidx = first_index { $_ == $opts{p}, @platforms } or
            die "wrong platform $opts{p}\n";
    } else {
        my @try_platforms = ($branch, $config->val('defaults', 'platform'),
            abf_username() . '_personal');
        while (!defined $repoidx) {
            my $try = shift @try_platforms or die "cannot guess platform\n";
            $repoidx = first_index { $_ eq $try } @platforms;
        }
    }
    my $platformid = $project->repositories('platform', 'id')->[$repoidx];
    my $repoid = $project->repositories('id')->[$repoidx];

    # find repositories to include
    my $reponame = $project->repositories('name')->[$repoidx];
    my @repodeps = split /,/, $config->val('repodeps', $reponame);
    my $platform = $abf->platform(id => $platformid);
    my @includeidx = indexes { $_ ~~ @repodeps } @{$platform->repositories('name')};
    my @includerepos;
    foreach (@includeidx) {
        push @includerepos, $platform->repositories('id')->[$_];
    }

    # target arches
    my $spec = init_spec();
    my $header = $spec->srcheader();
    my @exclusivearch = $header->tag('exclusivearch');
    my @excludearch = $header->tag('excludearch');
    my $arches = $abf->arches();
    my @archids;
    foreach (@$arches) {
        if ((!@exclusivearch or $_->{name} ~~ @exclusivearch) and
            (!@excludearch or !($_->{name} ~~ @excludearch))) {
            push @archids, $_->{id};
        }
    }

    # now we can submit buildlists...
    foreach (@archids) {
        my $bl = $project->createbuildlist( commit_hash             => $gitrev,
                                            update_type             => $severity,
                                            save_to_repository_id   => $repoid,
                                            build_for_platform_id   => $platformid,
                                            auto_publish            => $opts{a} || 0,
                                            build_requires          => JSON::false,
                                            include_repos           => \@includerepos,
                                            arch_id                 => $_ );
        print_buildlist($bl);
    }
}

=head2 sync

Read source files from spec file, add text (or zero-legth) ones to git tree
and binary ones to I<.abf.yml>. Files not mentioned in spec will be removed
from git tree and I<.abf.yml>. New sources are downloaded from upstream if they
are not present in working directory.

=cut

sub sync {
    my $specfile = find_spec();
    my $spec = init_spec($specfile);
    my @sources = ($specfile, $spec->sources(), $spec->icon());
    my $git = shift || Git->repository(cwd())
        or die "Not in the git working directory\n";
    my @trackedfiles = split /\n/, $git->command('ls-files');
    my $abfyml = read_abfyml();

    fetch($spec, $abfyml);
    if ($abfyml) {
        foreach my $file (keys %{$abfyml->{sources}}) {
            if ($file ~~ @sources) {
                unless (checkfilestore($abfyml->{sources}{$file})) {
                }
            } else {
                delete $abfyml->{sources}{$file};
                print "$file removed from .abf.yml\n";
            }
        }
    }

    foreach my $file (@sources) {
        unless ($abfyml->{sources}{$file}) {
            if (-f $file) {
                if (-T _) {
                    unless ($file ~~ @trackedfiles) {
                        $git->command('add', $file);
                        print "$file added to git index\n";
                    }
                } else {
                    my $ctx = Digest::SHA1->new();
                    open(my $FILE, "<", $file);
                    $ctx->addfile($FILE);
                    $abfyml->{sources}{$file} = $ctx->hexdigest();
                    print "$file added to .abf.yml\n";
                    unless (checkfilestore($abfyml->{sources}{$file})) {
                    }
                }
            } else {
                warn "No such file: $file\n";
            }
        }
    }

    YAML::XS::DumpFile('.abf.yml', $abfyml);

    unless ('.abf.yml' ~~ @trackedfiles) {
        $git->command('add', '.abf.yml') and print "added .abf.yml\n";
    }
    push @sources, '.abf.yml';

    foreach my $file (@trackedfiles) {
        if ($file ~~ @sources) {
            if ($abfyml->{sources}{$file}) {
                $git->command('rm', '--cached', $file);
                print "$file removed from git index\n";
            }
        } else {
            $git->command('rm', $file);
            print "$file removed\n";
        }
    }
}

=head2 upload

Upload files listed in I<.abf.yml> to file store if they were not yet. If you
have updated your specfile, you should run

    bfc sync

before to get sources locally and add them to I<.abf.yml>.

=cut

sub upload {
    my @files;
    if (@_) {
        @files = @_;
    } else {
        my $abfyml = read_abfyml();
        if ($abfyml) {
            foreach my $file (keys %{$abfyml->{sources}}) {
                unless (checkfilestore($abfyml->{sources}{$file})) {
                    if (-f $file) {
                        push @files, $file;
                    } else {
                        warn "No such file: $file\n";
                    }
                }
            }
        }
    }
    fs_upload(@files);
}

sub checkfilestore {
    my ($sha1) = @_ or return;
    my $baseurl = $config->val('file-store', 'baseurl');
    my $url = "$baseurl/download/$sha1";
    my $status = check_link($url);
    if ($status == 404) {
        return 0;
    } elsif ($status == 200) {
        return 1;
    } else {
        warn "Warning: requesting $url failed\n";
        warn "HTTP response: $status: $HTTP::SimpleLinkChecker::ERROR\n";
        return -1;
    }
 
}

sub find_spec {
    my ($specfile) = <*.spec>
        or die "Can't find any spec file\n";
    return $specfile;
}

sub init_spec {
    my ($specfile) = @_ ? @_ : (find_spec());
    my $rpm_class = Youri::Package::RPM->get_wrapper_class();
    $rpm_class->set_verbosity(0);
    set_rpm_dirs();
    my $spec = $rpm_class->new_spec($specfile, anyarch => 1, force => 1)
        or die "Can't parse spec file $specfile\n";
    return $spec;
}

sub read_abfyml {
    my $abfyml;
    if (-r '.abf.yml') {
        $abfyml = YAML::XS::LoadFile('.abf.yml');
    }
    return $abfyml;
}

sub set_rpm_dirs {
    my $rpm_class = Youri::Package::RPM->get_wrapper_class();
    foreach ("_sourcedir", "_specdir") {
        $rpm_class->add_macro("$_ " . cwd());
    }
}

sub download {
    my ($url, $file) = @_;
    my $ua = LWP::UserAgent->new();
    $ua->show_progress(1);
    $ua->ssl_opts( SSL_ca_path => '/etc/pki/tls/rootcerts' )
        unless $ua->ssl_opts('SSL_ca_path') || $ua->ssl_opts('SSL_ca_file');
    my $response = $ua->get($url, ':content_file' => $file);
    warn "Can't download $url\n" if $response->is_error();
}

sub fs_upload {
    my $baseurl = fs_baseurl();
    my @results;
    my $ua = LWP::UserAgent->new;
    my ($protocol, $host, $port) = $baseurl =~ m|^(\w+)://([\w.-]+)(?::(\d+))?|;
    $port = $protocol eq 'https' ? 443 : 80 unless $port;
    $ua->credentials("$host:$port", 'Application', fs_username(), fs_password());
    foreach (@_) {
        my ($filename) = m{([^/]+)$};
        my $url = "$baseurl/api/v1/upload";
        $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
        my $request = POST $url,
                Content_Type    => 'form-data',
                Content         => [ name               => $filename,
                                    'file_store[file]'  => [$_] ];
        print "Uploading $filename\n";
        my $result = $ua->request($request);
        if ($result->is_error()) {
            warn "Error uploading $filename: " .
                    $result->code . ": " .
                    $result->message . "\n";
        } else {
            push @results, $result->content;
        }
    }
    return @results;
}

sub fs_baseurl {
    my $url = $config->val('file-store', 'baseurl');
    $url =~ s|/$||;
    return $url;
}

sub fs_username {
    my ($hostname) = $config->val('file-store', 'baseurl') =~ m{(?<=://)([a-z0-9-.]+)};
    my $netrc = Net::Netrc->lookup(fs_hostname());
    my $username;
    if ($netrc) {
        $username = $netrc->login;
    } else {
        print "ABF file store username: ";
        $username = <>;
        chomp $username;
    }
    return $username;
}

sub fs_password {
    my $netrc = Net::Netrc->lookup(fs_hostname());
    my $password;
    if ($netrc) {
        $password = $netrc->password;
    } else {
        print "ABF file store password: ";
        ReadMode 'noecho';
        $password = <>;
        ReadMode 'restore';
        chomp $password;
    }
    return $password;
}

sub fs_hostname {
    $config->val('file-store', 'baseurl') =~ m{(?<=://)([a-z0-9-.]+)};
}

sub abf_username {
    my ($hostname) = abf_hostname() =~ m{(?<=://)([a-z0-9-.]+)};
    my $netrc = Net::Netrc->lookup(abf_hostname());
    my $username;
    if ($netrc) {
        $username = $netrc->login;
    } else {
        print "ABF username: ";
        $username = <>;
        chomp $username;
    }
    return $username;
}

sub abf_password {
    my $netrc = Net::Netrc->lookup(abf_hostname());
    my $password;
    if ($netrc) {
        $password = $netrc->password;
    } else {
        print "ABF password: ";
        ReadMode 'noecho';
        $password = <>;
        ReadMode 'restore';
        chomp $password;
    }
    return $password;
}

sub abf_hostname {
    $config->val('abf', 'baseurl') =~ m{(?<=://)([a-z0-9-.]+)};
}

sub fullname {
    my $name = shift;
    if ($name =~ m{^[\w+.-]+/[\w+.-]+$}) {
        return $name;
    } elsif ($name =~ m{^[\w+.-]+$}) {
        my $owner = $config->val('defaults', 'owner') || abf_username()
            or die "cannot guess owner of project $name";
        return "$owner/$name";
    } else {
        die "invalid project name $name";
    }
}

sub print_buildlist {
    my $bl = shift;

    format STDOUT=
---
Build:  @<<<<<<<           Project:    @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        $bl->id(),                     $bl->project('fullname'),
Status: @<<<<<<<<<<<<<<<<< Commit:     @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        $bl->strstatus()    ,          $bl->commit_hash(),
                           Repository: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
           $bl->build_for_platform('name').' '.$bl->save_to_repository('name'),
                           Arch:       @<<<<<
                                       $bl->arch('name'),
.

    write()
}

__END__

=head1 CONFIGURATION FILES

Global configuration is stored in I</etc/bfc.conf>. See comments in that 
for further information. User settings in I<$HOME/.bfc.conf> override glo
settings.

Authentication data for AFB and ABF File Store can be taken from
I<$HOME/.netrc> file. See L<netrc(5)> man page. Note that there must be
separate records for ABF itself and File Store.

=head1 COPYRIGHT

Copyright (C) 2012, Dmitry Mikhirev

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see L<http://www.gnu.org/licenses/>.

