debpaste

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 debpaste - http://paste.debian.net/ XML-RPC client
   6
   7 =cut
   8
   9 # Author: Hanno Hecker <vetinari@ankh-morp.org>
  10 # With patches from Richard Hartmann <richih.mailinglist@gmail.com>
  11 # Licence: AGPL 3.0 (http://www.fsf.org/licensing/licenses/agpl-3.0.html)
  12 # Version: $Id: debpaste 19 2009-04-15 08:15:25Z vetinari $
  13 # SVN: http://svn.ankh-morp.org:8080/tools/debpaste/
  14 #
  15 # Required:
  16 #  deb: perl-base perl-modules
  17 #       libtimedate-perl libfrontier-rpc-perl libtext-iconv-perl
  18 #
  19 # ToDo:
  20 #  * "get" formatting?
  21 #  * wishlist :)
  22 #
  23
  24 use strict;
  25 use Pod::Usage;
  26 use Getopt::Long;
  27 use File::Basename;
  28 my %config;
  29 my $VERSION;
  30 $VERSION = '1.1';
  31
  32 =head1 SYNOPSIS
  33
  34 B<debpaste> ACTION [OPTIONS] [CODE|ID]
  35
  36 =head1 ACTIONS
  37
  38 =over 4
  39
  40 =item add
  41
  42 Usage: debpaste add [OPTIONS] [CODE]
  43
  44 Adds a new paste to L<http://paste.debian.net/>. If no code is given on the
  45 command line, it will read from stdin.
  46
  47 Your paste infos are saved to I<~/.debpaste_history>
  48
  49 =item del
  50
  51 Usage: debpaste del [OPTIONS] ID
  52
  53 Deletes paste with id ID. This must be an ID which you have pasted before
  54 (and is in your history file)
  55
  56 =item get
  57
  58 Usage: debpaste get [OPTIONS] ID
  59
  60 Fetches the paste with id ID from L<http://paste.debian.net>. To C<download>
  61 a paste use something like
  62
  63  debpaste get --noheader ID > OUTFILE
  64
  65 =item lang
  66
  67 Usage: debpaste lang [OPTIONS]
  68
  69 Dumps the list of available languages for syntax highlighting, use the
  70 B<--lang=LANG> option when B<add>ing a paste.
  71
  72 =item edit
  73
  74 Usage: debpaste edit [OPTIONS] ID
  75
  76 Downloads the paste with id ID, spawns an editor, and sends the edited file
  77 as new paste.
  78
  79 =item expire
  80
  81 Usage: debpaste expire [OPTIONS] [ID]
  82
  83 Removes the entry ID from history file. If no ID is given it removes all
  84 entries which are expired.
  85
  86 =back
  87
  88 =head1 OPTIONS
  89
  90 =over 4
  91
  92 =item --user=USERNAME
  93
  94 paste as USERNAME instead of C<anonymous>
  95
  96 =item --server=URL
  97
  98 use URL instead of http://paste.debian.net/server.pl
  99
 100 =item --noproxy
 101
 102 do not use the http proxy given in the environment variable C<http_proxy>
 103
 104 =item --lang=LANG
 105
 106 use LANG for syntax highlight ('debpaste lang' for available languages)
 107
 108 =item --expires=SEC
 109
 110 expires in SEC seconds (default: 259200 = 72h)
 111
 112 =item --encoding=ENC
 113
 114 when adding new paste, use ENC as encoding of file, default: UTF-8
 115
 116 =item --noheader
 117
 118 when B<get>ting entries, don't print header, just dump the paste to stdout.
 119
 120 =item --version
 121
 122 print version and exit
 123
 124 =back
 125
 126 =cut
 127
 128 binmode(STDOUT, ":utf8");
 129 binmode(STDERR, ":utf8");
 130
 131 $0 = basename $0;
 132
 133 =head1 FILES
 134
 135 =over 4
 136
 137 =item ~/.debpasterc
 138
 139 The right place for setting default options like the username or expire values.
 140 Format is C<KeyInAnYCase: value>, example:
 141
 142    User: Vetinari
 143    Expires: 86400
 144
 145 =item ~/.debpaste_history
 146
 147 All info about pastes done with B<debpaste> are recorded here. This file
 148 is used to keep a record for B<del>eting entries after pasting. Use
 149 B<debpaste expire> to remove old entries.
 150
 151 =back
 152
 153 =cut
 154
 155 my $settings = $ENV{HOME}."/.debpasterc";
 156
 157 ## Don't change, edit $settings file:
 158 ## KeYInAnyCaSE: value
 159 ## AnoThErKey: other-value
 160 my $history  = $ENV{HOME}."/.debpaste_history";
 161 %config = (
 162     server        => "http://paste.debian.net/server.pl",
 163     user          => "anonymous",
 164     lang          => "",
 165     expires       => 86400 * 3, #
 166     history_file  => $history,
 167     no_get_header => 0,
 168 );
 169
 170 my $action = 'help';
 171 my %help   = ( #XXX we probably need to tie this hash so print_help() works nicely
 172         'add'  => "\n"
 173              ."Usage: $0 add [OPTIONS] [CODE]\n"
 174              ."  Adds a new paste to http://paste.debian.net/\n"
 175              ."  If no code is given on the command line, it will read from\n"
 176              ."  stdin.\n"
 177              ."  Your paste infos are saved to $history\n",
 178         'get'  => "\n"
 179              ."Usage: $0 get [OPTIONS] ID\n"
 180              ."  Fetches the paste with id ID from paste.debian.net\n"
 181              ."  To 'download' a paste use something like\n"
 182              ."   $0 get --noheader ID > OUTFILE\n",
 183         'del'  => "\n"
 184              ."Usage: $0 del [OPTIONS] ID\n"
 185              ."  Deletes paste with id ID. This must be an ID which you have\n"
 186              ."  pasted before (and is in your history file)\n",
 187         'lang' => "\n"
 188              ."Usage: $0 lang [OPTIONS]\n"
 189              ."  Dumps the list of available languages for syntax highlighting\n",
 190         'edit' => "\n"
 191              ."Usage: $0 edit [OPTIONS] ID\n"
 192              ."  Downloads the paste with id ID, spawns an editor (\$EDITOR)\n"
 193              ."  and sends the edited file as new paste\n",
 194         'expire' => "\n"
 195              ."Usage: $0 expire [OPTIONS] [ID]\n"
 196              ."  Removes the entry ID from history file. If no ID is given,\n"
 197              ."  it removes all entries which are expired.\n",
 198         # 'help' => "FIXME: help",
 199     );
 200
 201 if (@ARGV and $ARGV[0] !~ /^-/) {
 202     $action = shift @ARGV;
 203 }
 204
 205 &read_settings();
 206
 207 # This needs to be here so we can be called with --help
 208 sub print_help {
 209     print "Short usage help:\n\n";
 210     foreach my $key (keys %help) {
 211         print "$key $help{$key}\n";
 212     }
 213 }
 214
 215 GetOptions(
 216         "user=s"    => \$config{user},
 217         "server=s"  => \$config{server},
 218         "expires=s" => \$config{expires},
 219         "lang=s"    => \$config{lang},
 220         "encoding=s"=> \$config{encoding},
 221         "noheader"  => \$config{no_get_header},
 222         "help"      => sub { print_help(); exit 0 },
 223         "usage"     => sub { pod2usage(-exitval => 0, -verbose => 2); exit 0 },
 224         "version"   => sub { print "debpaste v$VERSION\n"; exit 0; },
 225     )
 226   or print_help; #XXX do we _ever_ reach this situation? I think not -- RH 091123
 227
 228 if ($action and $action eq "help") {
 229     $action = shift @ARGV
 230       if (@ARGV and $ARGV[0] !~ /^-/);
 231     &help($action);
 232     exit 0;
 233 }
 234
 235 my $paste = Debpaste->new(%config);
 236 if ($paste->can($action) and $action ne "new" and $action !~ /^_/) {
 237     $paste->$action();
 238 } else {
 239     die "$0: err... unknown action $action...\n";
 240 }
 241
 242 sub read_settings {
 243     open SET, $settings
 244       or return;
 245     while (defined (my $line = <SET>)) {
 246         next unless $line =~ /^(\w+):\s+(.*)$/;
 247         my ($key, $value) = (lc $1, $2);
 248         unless (exists $config{$key}) {
 249             warn "$0: unknown config key '$key' found\n";
 250             next;
 251         }
 252         ($config{$key} = $value) =~ s/^\s*(.*?)\s*$/$1/;
 253     }
 254     close SET;
 255 }
 256
 257
 258 sub help {
 259     my $msg = "";
 260     if (exists $help{$_[0]}) {
 261         ($msg = $help{$_[0]}."\n") if (exists $help{$_[0]});
 262     } else {
 263         print_help;
 264     }
 265 }
 266
 267 ###################################################################
 268
 269 package Debpaste;
 270 use Frontier::Client;
 271 use Date::Parse;
 272 use POSIX qw(strftime);
 273 use File::Temp qw(tempfile);
 274 use Text::Iconv;
 275
 276 sub new {
 277     my $me   = shift;
 278     my %args = @_;
 279     my $type = ref($me) || $me;
 280     my $self = {};
 281     bless $self, $type;
 282     foreach (keys %args) {
 283         $self->{$_} = $args{$_};
 284     }
 285     unless (exists $self->{editor}) {
 286         $self->{editor} = $ENV{EDITOR} ?
 287                             $ENV{EDITOR} : ($ENV{VISUAL} ?
 288                                             $ENV{VISUAL} : "/usr/bin/editor");
 289     }
 290     $self->{encoding} = "UTF-8" unless $self->{encoding};
 291     $self->{expires}  += time;
 292     my %fc = ( url => $self->{server} );
 293     unless ($self->{noproxy}) {
 294         $fc{proxy} = $ENV{http_proxy} if $ENV{http_proxy};
 295     }
 296     $self->{_service} = Frontier::Client->new(%fc);
 297     $self;
 298 }
 299
 300 sub _to_utf8 {
 301     my ($self,$txt) = @_;
 302     my $enc = $self->{encoding};
 303     return $txt if $enc eq "UTF-8";
 304
 305     my $i = eval { Text::Iconv->new($enc, "UTF-8"); };
 306     die "$0: unsupported encoding $enc\n" if $@;
 307
 308     my $new = $i->convert($txt);
 309     return $txt unless $new;
 310     return $new;
 311 }
 312
 313 sub _error {
 314     my ($self, $msg) = @_;
 315     unlink $self->{_tempfile} if $self->{_tempfile};
 316     die "$0: $msg\n";
 317 }
 318
 319 sub lang {
 320     my $self  = shift;
 321     my $rc    = $self->{_service}->call("paste.getLanguages");
 322     die $rc->{statusmessage},"\n" if $rc->{rc};
 323     ## print $rc->{statusmessage},"\n";
 324     print "Available syntax highlights:\n";
 325     foreach (@{$rc->{langs}}) {
 326         print " $_\n";
 327     }
 328 }
 329
 330 sub get {
 331     my $self = shift;
 332     my $id   = shift @ARGV;
 333     die "$0: no id given\n" unless $id;
 334     my $rc    = $self->{_service}->call("paste.getPaste", $id);
 335     die $rc->{statusmessage},"\n" if $rc->{rc};
 336     # ugly, but dates are ok then...
 337     # FIXME: probably only works with paste.d.n's timezone:
 338     my $stime    = str2time($rc->{submitdate}, "CET") - 3600;
 339     my $sub_date = strftime('%Y-%m-%d %H:%M:%S', localtime $stime);
 340     my $exp_date = strftime('%Y-%m-%d %H:%M:%S',
 341                     localtime($stime + $rc->{expiredate}));
 342     unless ($self->{no_get_header}) {
 343         print "User: ", $rc->{submitter}, "\n",
 344               "Date: $sub_date\n",
 345               "Expires: $exp_date\n",
 346               "---------------------------------\n";
 347     }
 348     print $rc->{code},"\n";
 349 }
 350
 351 sub edit {
 352     my $self = shift;
 353     my $id   = shift @ARGV;
 354     die "$0: no id given\n" unless $id;
 355
 356     my $rc    = $self->{_service}->call("paste.getPaste", $id);
 357     die $rc->{statusmessage},"\n" if $rc->{rc};
 358     my $new = $self->_spawn_editor($rc->{code});
 359     if (!$new or ($new eq $rc->{code})) {
 360         print "$0: not changed, aborting...\n";
 361         exit 0;
 362     }
 363     ## FIXME: text from paste.debian.net is probably UTF-8
 364     ## $new = $self->_to_utf8($new);
 365     $rc = $self->{_service}->call("paste.addPaste", $new,
 366                             $self->{user},
 367                             $self->{expires} - time,
 368                             $self->{lang});
 369     die $rc->{statusmessage},"\n"
 370       if $rc->{rc};
 371     print $rc->{statusmessage},"\n";
 372     print "To delete this entry, use: $0 del $rc->{id}\n";
 373     $self->save_entry($rc);
 374 }
 375
 376 sub _spawn_editor {
 377     my ($self, $txt) = @_;
 378     my $fh;
 379
 380     ($fh, $self->{_tempfile}) = tempfile("debpaste.XXXXXX", DIR => "/tmp");
 381
 382     $self->_error("Could not create temp file: $!")
 383       unless ($fh and $self->{_tempfile});
 384     print $fh $txt or $self->_error("Could not print to tempfile: $!");
 385     close $fh      or $self->_error("Failed to close tempfile: $!");
 386
 387     if (system($self->{editor}, $self->{_tempfile}) != 0) {
 388         $self->_error("failed to execute: $!")
 389             if $? == -1;
 390
 391         $self->_error(sprintf('child died with signal %d, %s coredump',
 392                             ($? & 127),  ($? & 128) ? 'with' : 'without'))
 393             if $? & 127;
 394
 395         $self->error(sprintf('editor exited with value %d', $? >> 8));
 396     }
 397
 398     open FH, $self->{_tempfile}
 399       or $self->_error("Failed to open temp file: $!");
 400     {
 401         local $/ = undef;
 402         $txt = <FH>;
 403     };
 404     close FH;
 405     unlink $self->{_tempfile};
 406     return $txt;
 407 }
 408
 409 sub delete { $_[0]->del(); }
 410 sub del {
 411     my $self = shift;
 412     my %entry = ();
 413     my $id   = shift @ARGV;
 414     die "$0: no id given\n" unless $id;
 415     open FILE, $self->{history_file}
 416       or die "$0: failed to open history file: $!\n";
 417     {
 418         local $/ = "\n\n";
 419         while (<FILE>) {
 420             s#^[\n\s]+##ms;
 421             s#[\n\s]+$##ms;
 422             next unless $_;
 423             %entry = map { /^(\S+):\s*(.*?)\s*$/;
 424                            ($1, $2 ? $2 : "")     } split /\n/, $_;
 425             last if ($entry{Entry} and $entry{Entry} eq $id);
 426             %entry = ();
 427         }
 428     }
 429     die "$0: Entry for $id not found...\n" unless $entry{Entry};
 430     die "$0: No Digest for $id\n" unless $entry{Digest};
 431     die "$0: Entry $id expired at ", scalar(localtime($entry{Expires})),"\n"
 432       if ($entry{Expires} and $entry{Expires} < time);
 433
 434     my $rc = $self->{_service}->call("paste.deletePaste", $entry{Digest});
 435     die $rc->{statusmessage},"\n" if $rc->{rc};
 436     print $rc->{statusmessage},"\n",
 437           "$0: deleted paste id ",$rc->{id},"\n";
 438     $self->_expire($rc->{id});
 439 }
 440
 441 sub expire {
 442     my $self = shift;
 443     my $id   = shift @ARGV;
 444     $self->_expire($id);
 445 }
 446
 447 sub _expire {
 448     my ($self, $id) = @_;
 449     my @history = ();
 450     my %entry;
 451     my @ids = ();
 452     open FILE, $self->{history_file}
 453       or return;
 454     {
 455         local $/ = "\n\n";
 456         while (<FILE>) {
 457             s#^[\n\s]+##ms;
 458             s#[\n\s]+$##ms;
 459             next unless $_;
 460             %entry = map { /^(\S+):\s*(.*?)\s*$/;
 461                            ($1, $2 ? $2 : "")     } split /\n/, $_;
 462
 463             ## print "ID: $entry{Entry}\n";
 464             if ($id) {
 465                 if ($entry{Entry} and $entry{Entry} eq $id) {
 466                     push @ids, $entry{Entry};
 467                     next;
 468                 }
 469             } elsif ($entry{Expires} and $entry{Expires} < time) {
 470                 push @ids, $entry{Entry};
 471                 next;
 472             }
 473             push @history, { %entry };
 474         }
 475     }
 476     close FILE;
 477     open FILE, ">", $self->{history_file}
 478       or die "$0: Failed to open history file: $!\n";
 479     foreach my $h (@history) {
 480         foreach (keys %{$h}) {
 481             next unless $_;
 482             print FILE "$_: $h->{$_}\n";
 483         }
 484         print FILE "\n";
 485     }
 486     close FILE  or die "$0: failed to write: $!\n";
 487     print "$0: expired ", scalar(@ids), " entries from history",
 488             (@ids ? ": ".join(", ", @ids) : ""), "\n";
 489 }
 490
 491 sub add {
 492     my $self = shift;
 493
 494     my $code = undef;
 495     if (@ARGV) {
 496         $code = join("\n", @ARGV);
 497     } else {
 498         { local $/ = undef; $code = <STDIN>; }
 499     }
 500     die "$0: no code given\n"
 501       unless $code;
 502
 503     $code = $self->_to_utf8($code);
 504     my $rc = $self->{_service}->call("paste.addPaste", $code,
 505                             $self->{user},
 506                             $self->{expires} - time,
 507                             $self->{lang});
 508     die $rc->{statusmessage},"\n"
 509       if $rc->{rc};
 510     print $rc->{statusmessage},"\n";
 511     print "To delete this entry, use: $0 del $rc->{id}\n";
 512     $self->save_entry($rc);
 513 }
 514
 515 sub save_entry {
 516     my ($self, $rc) = @_;
 517     # return unless $self->{save_pastes};
 518     my $file = $self->{history_file}
 519      or return;
 520     open FILE, ">>", $file or die "$0: failed to open $file: $!\n";
 521     seek FILE, 0, 2        or die "$0: Failed to seek: $!\n";
 522     print FILE "Server: ",  $self->{server}, "\n",
 523                "Entry: ",   $rc->{id},       "\n",
 524                "Lang: ",    $self->{lang},   "\n",
 525                "Expires: ", $self->{expires},"\n",
 526                "Digest: ",  $rc->{digest},   "\n\n"
 527       or die "$0: Failed to save paste: $!\n";
 528     close FILE             or die "$0: Failed to save paste: $!\n";
 529 }
 530
 531 =head1 DOWNLOAD
 532
 533 L<http://ankh-morp.org/code/debpaste/debpaste> or
 534 L<SVN|http://svn.ankh-morp.org:8080/tools/debpaste/>
 535
 536 =head1 AUTHOR
 537
 538 Hanno Hecker <vetinari@ankh-morp.org>
 539 Some patches by Richard Hartmann <richih.mailinglist@gmail.com>
 540
 541 =cut
 542
 543
 544 # vim: ts=4 sw=4 expandtab syn=perl