#!/usr/bin/perl -w
#

=head1 NAME

debpaste - https://paste.debian.net/ XML-RPC client

=cut

# Author: Hanno Hecker <vetinari@ankh-morp.org>
# Licence: AGPL 3.0 (https://www.fsf.org/licensing/licenses/agpl-3.0.html)
# Version: $Id: debpaste 22 2009-11-19 17:23:47Z vetinari $
# SVN: http://svn.ankh-morp.org:8080/tools/paste-dn/
#
# Required:
#  deb: perl-base perl-modules
#       libtimedate-perl libfrontier-rpc-perl libtext-iconv-perl
#
# ToDo:
#  * "get" formatting?
#  * wishlist :)
#
use strict;
use Getopt::Long;
use Pod::Usage;
my %config;
my $VERSION = '1.1 ($Rev: 22 $)';

=head1 SYNOPSIS

B<debpaste> ACTION [OPTIONS] [CODE|ID]

=head1 ACTIONS

=over 4

=item add

Usage: debpaste add [OPTIONS] [CODE]

Adds a new paste to L<https://paste.debian.net/>. If no code is given on the
command line, it will read from stdin.

Your paste infos are saved to I<~/.debpaste.history>

=item del

Usage: debpaste del [OPTIONS] ID

Deletes paste with id ID. This must be an ID which you have pasted before
(and is in your history file)

=item get

Usage: debpaste get [OPTIONS] ID

Fetches the paste with id ID from L<https://paste.debian.net>. To C<download>
a paste use something like

 debpaste get --noheader ID > OUTFILE

=item lang

Usage: debpaste lang [OPTIONS]

Dumps the list of available languages for syntax highlighting, use the
B<--lang=LANG> option when B<add>ing a paste.

=item edit

Usage: debpaste edit [OPTIONS] ID

Downloads the paste with id ID, spawns an editor, and sends the edited file
as new paste.

=item expire

Usage: debpaste expire [OPTIONS] [ID]

Removes the entry ID from history file. If no ID is given it removes all
entries which are expired.

=back

=head1 OPTIONS

=over 4

=item --user=USERNAME

paste as USERNAME instead of C<anonymous>

=item --server=URL

use URL instead of https://paste.debian.net/server.pl

=item --noproxy

do not use the http proxy given in the environment variable C<http_proxy>

=item --lang=LANG

use LANG for syntax highlight ('debpaste lang' for available languages)

=item --expires=SEC

expires in SEC seconds (default: 259200 = 72h)

=item --encoding=ENC

when adding new paste, use ENC as encoding of file, default: UTF-8

=item --noheader

when B<get>ting entries, don't print header, just dump the paste to stdout.

=item --version

print version and exit

=back

=cut

binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");

$0 =~ s#.*/##;

=head1 FILES

=over 4

=item ~/.debpaste.rc

The right place for setting default options like the username or expire values.
Format is C<KeyInAnYCase: value>, example:

   User: Vetinari
   Expires: 86400

=item ~/.debpaste.history

All info about pastes done with B<debpaste> are recorded here. This file
is used to keep a record for B<del>eting entries after pasting. Use
B<debpaste expire> to remove old entries.

=back

=cut

my $settings = $ENV{HOME}."/.debpaste.rc";

## Don't change, edit $settings file:
## KeYInAnyCaSE: value
## AnoThErKey: other-value
my $history  = $ENV{HOME}."/.debpaste.history";
%config = (
    server   => "https://paste.debian.net/server.pl",
    user     => "anonymous",
    lang     => "",
    expires  => 86400 * 3, #
    history_file => $history,
    no_get_header => 0,
);
my $action = "help";
my %help   = (
        'add'  => "\n"
             ."Usage: $0 add [OPTIONS] [CODE]\n"
             ."  Adds a new paste to https://paste.debian.net/\n"
             ."  If no code is given on the command line, it will read from\n"
             ."  stdin.\n"
             ."  Your paste infos are saved to $history\n",
        'get'  => "\n"
             ."Usage: $0 get [OPTIONS] ID\n"
             ."  Fetches the paste with id ID from paste.debian.net\n"
             ."  To 'download' a paste use something like\n"
             ."   $0 get --noheader ID > OUTFILE\n",
        'del'  => "\n"
             ."Usage: $0 del [OPTIONS] ID\n"
             ."  Deletes paste with id ID. This must be an ID which you have\n"
             ."  pasted before (and is in your history file)\n",
        'lang' => "\n"
             ."Usage: $0 lang [OPTIONS]\n"
             ."  Dumps the list of available languages for syntax highlighting\n",
        'edit' => "\n"
             ."Usage: $0 edit [OPTIONS] ID\n"
             ."  Downloads the paste with id ID, spawns an editor (\$EDITOR)\n"
             ."  and sends the edited file as new paste\n",
        'expire' => "\n"
             ."Usage: $0 expire [OPTIONS] [ID]\n"
             ."  Removes the entry ID from history file. If no ID is given,\n"
             ."  it removes all entries which are expired.\n",
        # 'help' => "FIXME: help",
    );

if (@ARGV and $ARGV[0] !~ /^-/) {
    $action = shift @ARGV;
}

&read_settings();

GetOptions(
        "user=s"    => \$config{user},
        "server=s"  => \$config{server},
        "expires=s" => \$config{expires},
        "lang=s"    => \$config{lang},
        "encoding=s"=> \$config{encoding},
        "noheader"  => \$config{no_get_header},
        "help"      => sub { pod2usage(-exitval => 0, -verbose => 2) },
        "version"   => sub { print "debpaste v$VERSION\n"; exit 0; },
    )
  or pod2usage(-exitval => 1, -verbose => 2);

if ($action and $action eq "help") {
    $action = shift @ARGV
      if (@ARGV and $ARGV[0] !~ /^-/);
    &help($action);
    exit 0;
}

my $paste = PasteDN->new(%config);
if ($paste->can($action) and $action ne "new" and $action !~ /^_/) {
    $paste->$action();
}
else {
    die "$0: err... unknown action $action...\n";
}

sub read_settings {
    open SET, $settings
      or return;
    while (defined (my $line = <SET>)) {
        next unless $line =~ /^(\w+):\s+(.*)$/;
        my ($key, $value) = (lc $1, $2);
        unless (exists $config{$key}) {
            warn "$0: unknown config key '$key' found\n";
            next;
        }
        ($config{$key} = $value) =~ s/^\s*(.*?)\s*$/$1/;
    }
    close SET;
}

sub help {
    my $msg = "";
    ($msg = $help{$_[0]}."\n") if (exists $help{$_[0]});
    pod2usage(-exitval => 0, -verbose => 2, -message => $msg);
}

###################################################################

package PasteDN;
use Frontier::Client;
use Date::Parse;
use POSIX qw(strftime);
use File::Temp qw(tempfile);
use Text::Iconv;

sub new {
    my $me   = shift;
    my %args = @_;
    my $type = ref($me) || $me;
    my $self = {};
    bless $self, $type;
    foreach (keys %args) {
        $self->{$_} = $args{$_};
    }
    unless (exists $self->{editor}) {
        $self->{editor} = $ENV{EDITOR} ?
                            $ENV{EDITOR} : ($ENV{VISUAL} ?
                                            $ENV{VISUAL} : "/usr/bin/editor");
    }
    $self->{encoding} = "UTF-8" unless $self->{encoding};
    $self->{expires}  += time;
    my %fc = ( url => $self->{server} );
    unless ($self->{noproxy}) {
        $fc{proxy} = $ENV{http_proxy} if $ENV{http_proxy};
    }
    $self->{_service} = Frontier::Client->new(%fc);
    $self;
}

sub _to_utf8 {
    my ($self,$txt) = @_;
    my $enc = $self->{encoding};
    return $txt if $enc eq "UTF-8";

    my $i = eval { Text::Iconv->new($enc, "UTF-8"); };
    die "$0: unsupported encoding $enc\n" if $@;

    my $new = $i->convert($txt);
    return $txt unless $new;
    return $new;
}

sub _error {
    my ($self, $msg) = @_;
    unlink $self->{_tempfile} if $self->{_tempfile};
    die "$0: $msg\n";
}

sub lang {
    my $self  = shift;
    my $rc    = $self->{_service}->call("paste.getLanguages");
    die $rc->{statusmessage},"\n" if $rc->{rc};
    ## print $rc->{statusmessage},"\n";
    print "Available syntax highlights:\n";
    foreach (@{$rc->{langs}}) {
        print " $_\n";
    }
}

sub get {
    my $self = shift;
    my $id   = shift @ARGV;
    die "$0: no id given\n" unless $id;
    my $rc    = $self->{_service}->call("paste.getPaste", $id);
    die $rc->{statusmessage},"\n" if $rc->{rc};
    # ugly, but dates are ok then...
    # FIXME: probably only works with paste.d.n's timezone:
    my $stime    = str2time($rc->{submitdate}, "CET") - 3600;
    my $sub_date = strftime('%Y-%m-%d %H:%M:%S', localtime $stime);
    my $exp_date = strftime('%Y-%m-%d %H:%M:%S',
                    localtime($stime + $rc->{expiredate}));
    unless ($self->{no_get_header}) {
        print "User: ", $rc->{submitter}, "\n",
              "Date: $sub_date\n",
              "Expires: $exp_date\n",
              "---------------------------------\n";
    }
    print $rc->{code},"\n";
}

sub edit {
    my $self = shift;
    my $id   = shift @ARGV;
    die "$0: no id given\n" unless $id;

    my $rc    = $self->{_service}->call("paste.getPaste", $id);
    die $rc->{statusmessage},"\n" if $rc->{rc};
    my $new = $self->_spawn_editor($rc->{code});
    if (!$new or ($new eq $rc->{code})) {
        print "$0: not changed, aborting...\n";
        exit 0;
    }
    ## FIXME: text from paste.debian.net is probably UTF-8
    ## $new = $self->_to_utf8($new);
    $rc = $self->{_service}->call("paste.addPaste", $new,
                            $self->{user},
                            $self->{expires} - time,
                            $self->{lang});
    die $rc->{statusmessage},"\n"
      if $rc->{rc};
    print $rc->{statusmessage},"\n";
    print "To delete this entry, use: $0 del $rc->{id}\n";
    $self->_save_entry($rc);
}

sub _spawn_editor {
    my ($self, $txt) = @_;
    my $fh;

    ($fh, $self->{_tempfile}) = tempfile("debpaste.XXXXXX", DIR => "/tmp");

    $self->_error("Could not create temp file: $!")
      unless ($fh and $self->{_tempfile});
    print $fh $txt or $self->_error("Could not print to tempfile: $!");
    close $fh      or $self->_error("Failed to close tempfile: $!");

    if (system($self->{editor}, $self->{_tempfile}) != 0) {
        $self->_error("failed to execute: $!")
            if $? == -1;

        $self->_error(sprintf('child died with signal %d, %s coredump',
                            ($? & 127),  ($? & 128) ? 'with' : 'without'))
            if $? & 127;

        $self->error(sprintf('editor exited with value %d', $? >> 8));
    }

    open FH, $self->{_tempfile}
      or $self->_error("Failed to open temp file: $!");
    {
        local $/ = undef;
        $txt = <FH>;
    };
    close FH;
    unlink $self->{_tempfile};
    return $txt;
}

sub delete { $_[0]->del(); }
sub del {
    my $self = shift;
    my %entry = ();
    my $id   = shift @ARGV;
    die "$0: no id given\n" unless $id;
    open FILE, $self->{history_file}
      or die "$0: failed to open history file: $!\n";
    {
        local $/ = "\n\n";
        while (<FILE>) {
            s#^[\n\s]+##ms;
            s#[\n\s]+$##ms;
            next unless $_;
            %entry = map { /^(\S+):\s*(.*?)\s*$/;
                           ($1, $2 ? $2 : "")     } split /\n/, $_;
            last if ($entry{Entry} and $entry{Entry} eq $id);
            %entry = ();
        }
    }
    die "$0: Entry for $id not found...\n" unless $entry{Entry};
    die "$0: No Digest for $id\n" unless $entry{Digest};
    die "$0: Entry $id expired at ", scalar(localtime($entry{Expires})),"\n"
      if ($entry{Expires} and $entry{Expires} < time);

    my $rc = $self->{_service}->call("paste.deletePaste", $entry{Digest});
    die $rc->{statusmessage},"\n" if $rc->{rc};
    print $rc->{statusmessage},"\n",
          "$0: deleted paste id ",$rc->{id},"\n";
    $self->_expire($rc->{id});
}

sub expire {
    my $self = shift;
    my $id   = shift @ARGV;
    $self->_expire($id);
}

sub _expire {
    my ($self, $id) = @_;
    my @history = ();
    my %entry;
    my @ids = ();
    open FILE, $self->{history_file}
      or return;
    {
        local $/ = "\n\n";
        while (<FILE>) {
            s#^[\n\s]+##ms;
            s#[\n\s]+$##ms;
            next unless $_;
            %entry = map { /^(\S+):\s*(.*?)\s*$/;
                           ($1, $2 ? $2 : "")     } split /\n/, $_;

            ## print "ID: $entry{Entry}\n";
            if ($id) {
                if ($entry{Entry} and $entry{Entry} eq $id) {
                    push @ids, $entry{Entry};
                    next;
                }
            }
            elsif ($entry{Expires} and $entry{Expires} < time) {
                push @ids, $entry{Entry};
                next;
            }
            push @history, { %entry };
        }
    }
    close FILE;
    open FILE, ">", $self->{history_file}
      or die "$0: Failed to open history file: $!\n";
    foreach my $h (@history) {
        foreach (keys %{$h}) {
            next unless $_;
            print FILE "$_: $h->{$_}\n";
        }
        print FILE "\n";
    }
    close FILE  or die "$0: failed to write: $!\n";
    print "$0: expired ", scalar(@ids), " entries from history",
            (@ids ? ": ".join(", ", @ids) : ""), "\n";
}

sub add {
    my $self = shift;

    my $code = undef;
    if (@ARGV) {
        $code = join("\n", @ARGV);
    }
    else {
        { local $/ = undef; $code = <STDIN>; }
    }
    die "$0: no code given\n"
      unless $code;

    $code = $self->_to_utf8($code);
    my $rc = $self->{_service}->call("paste.addPaste", $code,
                            $self->{user},
                            $self->{expires} - time,
                            $self->{lang});
    die $rc->{statusmessage},"\n"
      if $rc->{rc};
    print $rc->{statusmessage},"\n";
    print "To delete this entry, use: $0 del $rc->{id}\n";
    $self->_save_entry($rc);
}

sub _save_entry {
    my ($self, $rc) = @_;
    # return unless $self->{save_pastes};
    my $file = $self->{history_file}
     or return;
    open FILE, ">>", $file or die "$0: failed to open $file: $!\n";
    seek FILE, 0, 2        or die "$0: Failed to seek: $!\n";
    print FILE "Server: ",  $self->{server}, "\n",
               "Entry: ",   $rc->{id},       "\n",
               "Lang: ",    $self->{lang},   "\n",
               "Expires: ", $self->{expires},"\n",
               "Digest: ",  $rc->{digest},   "\n\n"
      or die "$0: Failed to save paste: $!\n";
    close FILE             or die "$0: Failed to save paste: $!\n";
}

=head1 DOWNLOAD

L<http://ankh-morp.org/code/paste-dn/debpaste> or
L<SVN|http://svn.ankh-morp.org:8080/tools/paste-dn/>

=head1 NOTES

Renamed to C<debpaste> at Rev. 20

=head1 AUTHOR

Hanno Hecker <vetinari@ankh-morp.org>

=cut


# vim: ts=4 sw=4 expandtab syn=perl