debpaste

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