bin/rt

   1 #!/usr/bin/perl -w
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
   7 #                                          <sales@bestpractical.com>
   8 #
   9 # (Except where explicitly superseded by other copyright notices)
  10 #
  11 #
  12 # LICENSE:
  13 #
  14 # This work is made available to you under the terms of Version 2 of
  15 # the GNU General Public License. A copy of that license should have
  16 # been provided with this software, but in any event can be snarfed
  17 # from www.gnu.org.
  18 #
  19 # This work is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program; if not, write to the Free Software
  26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27 # 02110-1301 or visit their web page on the internet at
  28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  29 #
  30 #
  31 # CONTRIBUTION SUBMISSION POLICY:
  32 #
  33 # (The following paragraph is not intended to limit the rights granted
  34 # to you to modify and distribute this software under the terms of
  35 # the GNU General Public License and is only of importance to you if
  36 # you choose to contribute your changes and enhancements to the
  37 # community by submitting them to Best Practical Solutions, LLC.)
  38 #
  39 # By intentionally submitting any modifications, corrections or
  40 # derivatives to this work, or any other work intended for use with
  41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  42 # you are the copyright holder for those contributions and you grant
  43 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  44 # royalty-free, perpetual, license to use, copy, create derivative
  45 # works based on those contributions, and sublicense and distribute
  46 # those contributions and any derivatives thereof.
  47 #
  48 # END BPS TAGGED BLOCK }}}
  49 # Designed and implemented for Best Practical Solutions, LLC by
  50 # Abhijit Menon-Sen <ams@wiw.org>
  51
  52 use strict;
  53 use warnings;
  54
  55 if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) {
  56     require Pod::Usage;
  57     print Pod::Usage::pod2usage( { verbose => 2 } );
  58     exit;
  59 }
  60
  61 # This program is intentionally written to have as few non-core module
  62 # dependencies as possible. It should stay that way.
  63
  64 use Cwd;
  65 use LWP;
  66 use Text::ParseWords;
  67 use HTTP::Request::Common;
  68 use HTTP::Headers;
  69 use Term::ReadLine;
  70 use Time::Local; # used in prettyshow
  71 use File::Temp;
  72
  73 # strong (GSSAPI based) authentication is supported if the server does provide
  74 # it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed
  75 # it can be suppressed by setting externalauth=0 (default is undef)
  76 eval { require GSSAPI };
  77 my $no_strong_auth = 'missing perl module GSSAPI';
  78 if ( ! $@ ) {
  79     eval {require LWP::Authen::Negotiate};
  80     $no_strong_auth = $@ ? 'missing perl module LWP::Authen::Negotiate' : 0;
  81 }
  82
  83 # We derive configuration information from hardwired defaults, dotfiles,
  84 # and the RT* environment variables (in increasing order of precedence).
  85 # Session information is stored in ~/.rt_sessions.
  86
  87 my $VERSION = 0.02;
  88 my $HOME = eval{(getpwuid($<))[7]}
  89            || $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH}
  90            || ".";
  91 my %config = (
  92     (
  93         debug        => 0,
  94         user         => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
  95         passwd       => undef,
  96         server       => 'http://localhost/',
  97         query        => "Status!='resolved' and Status!='rejected'",
  98         orderby      => 'id',
  99         queue        => undef,
 100 # to protect against unlimited searches a better choice would be
 101 #       queue        => 'Unknown_Queue',
 102 # setting externalauth => undef will try GSSAPI auth if the corresponding perl
 103 # modules are installed, externalauth => 0 is the backward compatible choice
 104         externalauth => 0,
 105     ),
 106     config_from_file($ENV{RTCONFIG} || ".rtrc"),
 107     config_from_env()
 108 );
 109 my $session = Session->new("$HOME/.rt_sessions");
 110 my $REST = "$config{server}/REST/1.0";
 111 $no_strong_auth = 'switched off by externalauth=0'
 112     if defined $config{externalauth};
 113
 114
 115 my $prompt = 'rt> ';
 116
 117 sub whine;
 118 sub DEBUG { warn @_ if $config{debug} >= shift }
 119
 120 # These regexes are used by command handlers to parse arguments.
 121 # (XXX: Ask Autrijus how i18n changes these definitions.)
 122
 123 my $name    = '[\w.-]+';
 124 my $CF_name = '[^,]+?';
 125 my $field   = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
 126 my $label   = '[^,\\/]+';
 127 my $labels  = "(?:$label,)*$label";
 128 my $idlist  = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
 129
 130 # Our command line looks like this:
 131 #
 132 #     rt <action> [options] [arguments]
 133 #
 134 # We'll parse just enough of it to decide upon an action to perform, and
 135 # leave the rest to per-action handlers to interpret appropriately.
 136
 137 my %handlers = (
 138 #   handler     => [ ...aliases... ],
 139     version     => ["version", "ver"],
 140     shell       => ["shell"],
 141     logout      => ["logout"],
 142     help        => ["help", "man"],
 143     show        => ["show", "cat"],
 144     edit        => ["create", "edit", "new", "ed"],
 145     list        => ["search", "list", "ls"],
 146     comment     => ["comment", "correspond"],
 147     link        => ["link", "ln"],
 148     merge       => ["merge"],
 149     grant       => ["grant", "revoke"],
 150     take        => ["take", "steal", "untake"],
 151     quit        => ["quit", "exit"],
 152     setcommand  => ["del", "delete", "give", "res", "resolve",
 153                     "subject"],
 154 );
 155
 156 my %actions;
 157 foreach my $fn (keys %handlers) {
 158     foreach my $alias (@{ $handlers{$fn} }) {
 159         $actions{$alias} = \&{"$fn"};
 160     }
 161 }
 162
 163 # Once we find and call an appropriate handler, we're done.
 164
 165 sub handler {
 166     my $action;
 167
 168     push @ARGV, 'shell' if (!@ARGV);    # default to shell mode
 169     shift @ARGV if ($ARGV[0] eq 'rt');    # ignore a leading 'rt'
 170     if (@ARGV && exists $actions{$ARGV[0]}) {
 171         $action = shift @ARGV;
 172         return $actions{$action}->($action);
 173     }
 174     else {
 175         print STDERR "rt: Unknown command '@ARGV'.\n";
 176         print STDERR "rt: For help, run 'rt help'.\n";
 177         return 1;
 178     }
 179 }
 180
 181 exit handler();
 182
 183 # Handler functions.
 184 # ------------------
 185 #
 186 # The following subs are handlers for each entry in %actions.
 187
 188 sub shell {
 189     $|=1;
 190     my $term = Term::ReadLine->new('RT CLI');
 191     while ( defined ($_ = $term->readline($prompt)) ) {
 192         next if /^#/ || /^\s*$/;
 193
 194         @ARGV = shellwords($_);
 195         handler();
 196     }
 197 }
 198
 199 sub version {
 200     print "rt $VERSION\n";
 201     return 0;
 202 }
 203
 204 sub logout {
 205     submit("$REST/logout") if defined $session->cookie;
 206     return 0;
 207 }
 208
 209 sub quit {
 210     logout();
 211     exit;
 212 }
 213
 214 my %help;
 215 sub help {
 216     my ($action, $type, $rv) = @_;
 217     $rv = defined $rv ? $rv : 0;
 218     my $key;
 219
 220     # What help topics do we know about?
 221     if (!%help) {
 222         local $/ = undef;
 223         foreach my $item (@{ Form::parse(<DATA>) }) {
 224             my $title = $item->[2]{Title};
 225             my @titles = ref $title eq 'ARRAY' ? @$title : $title;
 226
 227             foreach $title (grep $_, @titles) {
 228                 $help{$title} = $item->[2]{Text};
 229             }
 230         }
 231     }
 232
 233     # What does the user want help with?
 234     undef $action if ($action && $actions{$action} eq \&help);
 235     unless ($action || $type) {
 236         # If we don't know, we'll look for clues in @ARGV.
 237         foreach (@ARGV) {
 238             if (exists $help{$_}) { $key = $_; last; }
 239         }
 240         unless ($key) {
 241             # Tolerate possibly plural words.
 242             foreach (@ARGV) {
 243                 if ($_ =~ s/s$// && exists $help{$_}) { $key = $_; last; }
 244             }
 245         }
 246     }
 247
 248     if ($type && $action) {
 249         $key = "$type.$action";
 250     }
 251     $key ||= $type || $action || "introduction";
 252
 253     # Find a suitable topic to display.
 254     while (!exists $help{$key}) {
 255         if ($type && $action) {
 256             if ($key eq "$type.$action") { $key = $action;        }
 257             elsif ($key eq $action)      { $key = $type;          }
 258             else                         { $key = "introduction"; }
 259         }
 260         else {
 261             $key = "introduction";
 262         }
 263     }
 264
 265     print STDERR $help{$key}, "\n\n";
 266     return $rv;
 267 }
 268
 269 # Displays a list of objects that match some specified condition.
 270
 271 sub list {
 272     my ($q, $type, %data);
 273     my $orderby = $config{orderby};
 274
 275     if ($config{orderby}) {
 276          $data{orderby} = $config{orderby};
 277     }
 278     my $bad = 0;
 279     my $rawprint = 0;
 280     my $reverse_sort = 0;
 281     my $queue = $config{queue};
 282
 283     while (@ARGV) {
 284         $_ = shift @ARGV;
 285
 286         if (/^-t$/) {
 287             $bad = 1, last unless defined($type = get_type_argument());
 288         }
 289         elsif (/^-S$/) {
 290             $bad = 1, last unless get_var_argument(\%data);
 291         }
 292         elsif (/^-o$/) {
 293             $data{'orderby'} = shift @ARGV;
 294         }
 295         elsif (/^-([isl])$/) {
 296             $data{format} = $1;
 297             $rawprint = 1;
 298         }
 299         elsif (/^-q$/) {
 300             $queue = shift @ARGV;
 301         }
 302         elsif (/^-r$/) {
 303             $reverse_sort = 1;
 304         }
 305         elsif (/^-f$/) {
 306             if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
 307                 whine "No valid field list in '-f $ARGV[0]'.";
 308                 $bad = 1; last;
 309             }
 310             $data{fields} = shift @ARGV;
 311             $data{format} = 's' if ! $data{format};
 312             $rawprint = 1;
 313         }
 314         elsif (!defined $q && !/^-/) {
 315             $q = $_;
 316         }
 317         else {
 318             my $datum = /^-/ ? "option" : "argument";
 319             whine "Unrecognised $datum '$_'.";
 320             $bad = 1; last;
 321         }
 322     }
 323     if ( ! $rawprint and ! exists $data{format} ) {
 324         $data{format} = 'l';
 325     }
 326     if ( $reverse_sort and $data{orderby} =~ /^-/ ) {
 327         $data{orderby} =~ s/^-/+/;
 328     } elsif ($reverse_sort) {
 329         $data{orderby} =~ s/^\+?(.*)/-$1/;
 330     }
 331
 332     if (!defined $q) {
 333         $q = $config{query};
 334     }
 335
 336     $q =~ s/^#//; # get rid of leading hash
 337     if ($q =~ /^\d+$/) {
 338         # only digits, must be an id, formulate a correct query
 339         $q = "id=$q" if $q =~ /^\d+$/;
 340     } else {
 341         # a string only, take it as an owner or requestor (quoting done later)
 342         $q = "(Owner=$q or Requestor like $q) and $config{query}"
 343              if $q =~ /^[\w\-]+$/;
 344         # always add a query for a specific queue or (comma separated) queues
 345         $queue =~ s/,/ or Queue=/g if $queue;
 346         $q .= " and (Queue=$queue)" if $queue and $q and $q !~ /Queue\s*=/i
 347             and $q !~ /id\s*=/i;
 348     }
 349     # correctly quote strings in a query
 350     $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g;
 351
 352     $type ||= "ticket";
 353     unless ($type && defined $q) {
 354         my $item = $type ? "query string" : "object type";
 355         whine "No $item specified.";
 356         $bad = 1;
 357     }
 358     #return help("list", $type) if $bad;
 359     return suggest_help("list", $type, $bad) if $bad;
 360
 361     print "Query:$q\n" if ! $rawprint;
 362     my $r = submit("$REST/search/$type", { query => $q, %data });
 363     if ( $rawprint ) {
 364         print $r->content;
 365     } else {
 366         my $forms = Form::parse($r->content);
 367         prettylist ($forms);
 368     }
 369     return 0;
 370 }
 371
 372 # Displays selected information about a single object.
 373
 374 sub show {
 375     my ($type, @objects, %data);
 376     my $slurped = 0;
 377     my $bad = 0;
 378     my $rawprint = 0;
 379     my $histspec;
 380
 381     while (@ARGV) {
 382         $_ = shift @ARGV;
 383         s/^#// if /^#\d+/; # get rid of leading hash
 384         if (/^-t$/) {
 385             $bad = 1, last unless defined($type = get_type_argument());
 386         }
 387         elsif (/^-S$/) {
 388             $bad = 1, last unless get_var_argument(\%data);
 389         }
 390         elsif (/^-([isl])$/) {
 391             $data{format} = $1;
 392             $rawprint = 1;
 393         }
 394         elsif (/^-$/ && !$slurped) {
 395             chomp(my @lines = <STDIN>);
 396             foreach (@lines) {
 397                 unless (is_object_spec($_, $type)) {
 398                     whine "Invalid object on STDIN: '$_'.";
 399                     $bad = 1; last;
 400                 }
 401                 push @objects, $_;
 402             }
 403             $slurped = 1;
 404         }
 405         elsif (/^-f$/) {
 406             if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
 407                 whine "No valid field list in '-f $ARGV[0]'.";
 408                 $bad = 1; last;
 409             }
 410             $data{fields} = shift @ARGV;
 411             # option f requires short raw listing format
 412             $data{format} = 's';
 413             $rawprint = 1;
 414         }
 415         elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
 416             push @objects, $spc2;
 417             $histspec = is_object_spec("ticket/$_/history", $type);
 418         }
 419         elsif (/^\d+\// and my $spc3 = is_object_spec("ticket/$_", $type)) {
 420             push @objects, $spc3;
 421             $rawprint = 1 if $_ =~ /\/content$/;
 422         }
 423         elsif (my $spec = is_object_spec($_, $type)) {
 424             push @objects, $spec;
 425             $rawprint = 1 if $_ =~ /\/content$/ or $_ =~ /\/links/ or $_ !~ /^ticket/;
 426         }
 427         else {
 428             my $datum = /^-/ ? "option" : "argument";
 429             whine "Unrecognised $datum '$_'.";
 430             $bad = 1; last;
 431         }
 432     }
 433     if ( ! $rawprint ) {
 434         push @objects, $histspec if $histspec;
 435         $data{format} = 'l' if ! exists $data{format};
 436     }
 437
 438     unless (@objects) {
 439         whine "No objects specified.";
 440         $bad = 1;
 441     }
 442     #return help("show", $type) if $bad;
 443     return suggest_help("show", $type, $bad) if $bad;
 444
 445     my $r = submit("$REST/show", { id => \@objects, %data });
 446     my $c = $r->content;
 447     # if this isn't a text reply, remove the trailing newline so we
 448     # don't corrupt things like tarballs when people do
 449     # show ticket/id/attachments/id/content > foo.tar.gz
 450     if ($r->content_type !~ /^text\//) {
 451         chomp($c);
 452         $rawprint = 1;
 453     }
 454     if ( $rawprint ) {
 455         print $c;
 456     } else {
 457         # I do not know how to get more than one form correctly returned
 458         $c =~ s!^RT/[\d\.]+ 200 Ok$!--!mg;
 459         my $forms = Form::parse($c);
 460         prettyshow ($forms);
 461     }
 462     return 0;
 463 }
 464
 465 # To create a new object, we ask the server for a form with the defaults
 466 # filled in, allow the user to edit it, and send the form back.
 467 #
 468 # To edit an object, we must ask the server for a form representing that
 469 # object, make changes requested by the user (either on the command line
 470 # or interactively via $EDITOR), and send the form back.
 471
 472 sub edit {
 473     my ($action) = @_;
 474     my (%data, $type, @objects);
 475     my ($cl, $text, $edit, $input, $output, $content_type);
 476
 477     use vars qw(%set %add %del);
 478     %set = %add = %del = ();
 479     my $slurped = 0;
 480     my $bad = 0;
 481
 482     while (@ARGV) {
 483         $_ = shift @ARGV;
 484         s/^#// if /^#\d+/; # get rid of leading hash
 485
 486         if    (/^-e$/) { $edit = 1 }
 487         elsif (/^-i$/) { $input = 1 }
 488         elsif (/^-o$/) { $output = 1 }
 489         elsif (/^-ct$/) { $content_type = shift @ARGV }
 490         elsif (/^-t$/) {
 491             $bad = 1, last unless defined($type = get_type_argument());
 492         }
 493         elsif (/^-S$/) {
 494             $bad = 1, last unless get_var_argument(\%data);
 495         }
 496         elsif (/^-$/ && !($slurped || $input)) {
 497             chomp(my @lines = <STDIN>);
 498             foreach (@lines) {
 499                 unless (is_object_spec($_, $type)) {
 500                     whine "Invalid object on STDIN: '$_'.";
 501                     $bad = 1; last;
 502                 }
 503                 push @objects, $_;
 504             }
 505             $slurped = 1;
 506         }
 507         elsif (/^set$/i) {
 508             my $vars = 0;
 509
 510             while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/s) {
 511                 my ($key, $op, $val) = ($1, $2, $3);
 512                 my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del;
 513
 514                 vpush($hash, lc $key, $val);
 515                 shift @ARGV;
 516                 $vars++;
 517             }
 518             unless ($vars) {
 519                 whine "No variables to set.";
 520                 $bad = 1; last;
 521             }
 522             $cl = $vars;
 523         }
 524         elsif (/^(?:add|del)$/i) {
 525             my $vars = 0;
 526             my $hash = ($_ eq "add") ? \%add : \%del;
 527
 528             while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/s) {
 529                 my ($key, $val) = ($1, $2);
 530
 531                 vpush($hash, lc $key, $val);
 532                 shift @ARGV;
 533                 $vars++;
 534             }
 535             unless ($vars) {
 536                 whine "No variables to set.";
 537                 $bad = 1; last;
 538             }
 539             $cl = $vars;
 540         }
 541         elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
 542             push @objects, $spc2;
 543         }
 544         elsif (my $spec = is_object_spec($_, $type)) {
 545             push @objects, $spec;
 546         }
 547         else {
 548             my $datum = /^-/ ? "option" : "argument";
 549             whine "Unrecognised $datum '$_'.";
 550             $bad = 1; last;
 551         }
 552     }
 553
 554     if ($action =~ /^ed(?:it)?$/) {
 555         unless (@objects) {
 556             whine "No objects specified.";
 557             $bad = 1;
 558         }
 559     }
 560     else {
 561         if (@objects) {
 562             whine "You shouldn't specify objects as arguments to $action.";
 563             $bad = 1;
 564         }
 565         unless ($type) {
 566             whine "What type of object do you want to create?";
 567             $bad = 1;
 568         }
 569         @objects = ("$type/new") if defined($type);
 570     }
 571     #return help($action, $type) if $bad;
 572     return suggest_help($action, $type, $bad) if $bad;
 573
 574     # We need a form to make changes to. We usually ask the server for
 575     # one, but we can avoid that if we are fed one on STDIN, or if the
 576     # user doesn't want to edit the form by hand, and the command line
 577     # specifies only simple variable assignments.  We *should* get a
 578     # form if we're creating a new ticket, so that the default values
 579     # get filled in properly.
 580
 581     my @new_objects = grep /\/new$/, @objects;
 582
 583     if ($input) {
 584         local $/ = undef;
 585         $text = <STDIN>;
 586     }
 587     elsif ($edit || %add || %del || !$cl || @new_objects) {
 588         my $r = submit("$REST/show", { id => \@objects, format => 'l' });
 589         $text = $r->content;
 590     }
 591
 592     # If any changes were specified on the command line, apply them.
 593     if ($cl) {
 594         if ($text) {
 595             # We're updating forms from the server.
 596             my $forms = Form::parse($text);
 597
 598             foreach my $form (@$forms) {
 599                 my ($c, $o, $k, $e) = @$form;
 600                 my ($key, $val);
 601
 602                 next if ($e || !@$o);
 603
 604                 local %add = %add;
 605                 local %del = %del;
 606                 local %set = %set;
 607
 608                 # Make changes to existing fields.
 609                 foreach $key (@$o) {
 610                     if (exists $add{lc $key}) {
 611                         $val = delete $add{lc $key};
 612                         vpush($k, $key, $val);
 613                         $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/;
 614                     }
 615                     if (exists $del{lc $key}) {
 616                         $val = delete $del{lc $key};
 617                         my %val = map {$_=>1} @{ vsplit($val) };
 618                         $k->{$key} = vsplit($k->{$key});
 619                         @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}};
 620                     }
 621                     if (exists $set{lc $key}) {
 622                         $k->{$key} = delete $set{lc $key};
 623                     }
 624                 }
 625
 626                 # Then update the others.
 627                 foreach $key (keys %set) { vpush($k, $key, $set{$key}) }
 628                 foreach $key (keys %add) {
 629                     vpush($k, $key, $add{$key});
 630                     $k->{$key} = vsplit($k->{$key});
 631                 }
 632                 push @$o, (keys %add, keys %set);
 633             }
 634
 635             $text = Form::compose($forms);
 636         }
 637         else {
 638             # We're rolling our own set of forms.
 639             my @forms;
 640             foreach (@objects) {
 641                 my ($type, $ids, $args) =
 642                     m{^($name)/($idlist|$labels)(?:(/.*))?$}o;
 643
 644                 $args ||= "";
 645                 foreach my $obj (expand_list($ids)) {
 646                     my %set = (%set, id => "$type/$obj$args");
 647                     push @forms, ["", [keys %set], \%set];
 648                 }
 649             }
 650             $text = Form::compose(\@forms);
 651         }
 652     }
 653
 654     if ($output) {
 655         print $text;
 656         return 0;
 657     }
 658
 659     my @files;
 660     @files = @{ vsplit($set{'attachment'}) } if exists $set{'attachment'};
 661
 662     my $synerr = 0;
 663
 664 EDIT:
 665     # We'll let the user edit the form before sending it to the server,
 666     # unless we have enough information to submit it non-interactively.
 667     if ( $type && $type eq 'ticket' && $text !~ /^Content-Type:/m ) {
 668         $text .= "Content-Type: $content_type\n"
 669             if $content_type and $content_type ne "text/plain";
 670     }
 671
 672     if ($edit || (!$input && !$cl)) {
 673         my ($newtext) = vi_form_while(
 674             $text,
 675             sub {
 676                 my ($text, $form) = @_;
 677                 return 1 unless exists $form->[2]{'Attachment'};
 678
 679                 foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) {
 680                     return (0, "File '$f' doesn't exist") unless -f $f;
 681                 }
 682                 @files = @{ vsplit($form->[2]{'Attachment'}) };
 683                 return 1;
 684             },
 685         );
 686         return $newtext unless $newtext;
 687         # We won't resubmit a bad form unless it was changed.
 688         $text = ($synerr && $newtext eq $text) ? undef : $newtext;
 689     }
 690
 691     delete @data{ grep /^attachment_\d+$/, keys %data };
 692     my $i = 1;
 693     foreach my $file (@files) {
 694         $data{"attachment_$i"} = bless([ $file ], "Attachment");
 695         $i++;
 696     }
 697
 698     if ($text) {
 699         my $r = submit("$REST/edit", {content => $text, %data});
 700         if ($r->code == 409) {
 701             # If we submitted a bad form, we'll give the user a chance
 702             # to correct it and resubmit.
 703             if ($edit || (!$input && !$cl)) {
 704                 $text = $r->content;
 705                 $synerr = 1;
 706                 goto EDIT;
 707             }
 708             else {
 709                 print $r->content;
 710                 return 0;
 711             }
 712         }
 713         print $r->content;
 714     }
 715     return 0;
 716 }
 717
 718 # handler for special edit commands. A valid edit command is constructed and
 719 # further work is delegated to the edit handler
 720
 721 sub setcommand {
 722     my ($action) = @_;
 723     my ($id, $bad, $what);
 724     if ( @ARGV ) {
 725         $_ = shift @ARGV;
 726         $id = $1 if (m|^(?:ticket/)?($idlist)$|);
 727     }
 728     if ( ! $id ) {
 729         $bad = 1;
 730         whine "No ticket number specified.";
 731     }
 732     if ( @ARGV ) {
 733         if ($action eq 'subject') {
 734             my $subject = '"'.join (" ", @ARGV).'"';
 735             @ARGV = ();
 736             $what = "subject=$subject";
 737         } elsif ($action eq 'give') {
 738             my $owner = shift @ARGV;
 739             $what = "owner=$owner";
 740         }
 741     } else {
 742         if ( $action eq 'delete' or $action eq 'del' ) {
 743             $what = "status=deleted";
 744         } elsif ($action eq 'resolve' or $action eq 'res' ) {
 745             $what = "status=resolved";
 746         } elsif ($action eq 'take' ) {
 747             $what = "owner=$config{user}";
 748         } elsif ($action eq 'untake') {
 749             $what = "owner=Nobody";
 750         }
 751     }
 752     if (@ARGV) {
 753         $bad = 1;
 754         whine "Extraneous arguments for action $action: @ARGV.";
 755     }
 756     if ( ! $what ) {
 757         $bad = 1;
 758         whine "unrecognized action $action.";
 759     }
 760     return help("edit", undef, $bad) if $bad;
 761     @ARGV = ( $id, "set", $what );
 762     print "Executing: rt edit @ARGV\n";
 763     return edit("edit");
 764 }
 765
 766 # We roll "comment" and "correspond" into the same handler.
 767
 768 sub comment {
 769     my ($action) = @_;
 770     my (%data, $id, @files, @bcc, @cc, $msg, $content_type, $wtime, $edit);
 771     my $bad = 0;
 772
 773     while (@ARGV) {
 774         $_ = shift @ARGV;
 775
 776         if (/^-e$/) {
 777             $edit = 1;
 778         }
 779         elsif (/^-(?:[abcmw]|ct)$/) {
 780             unless (@ARGV) {
 781                 whine "No argument specified with $_.";
 782                 $bad = 1; last;
 783             }
 784
 785             if (/-a/) {
 786                 unless (-f $ARGV[0] && -r $ARGV[0]) {
 787                     whine "Cannot read attachment: '$ARGV[0]'.";
 788                     return 0;
 789                 }
 790                 push @files, shift @ARGV;
 791             }
 792             elsif (/-ct/) {
 793                 $content_type = shift @ARGV;
 794             }
 795             elsif (/-([bc])/) {
 796                 my $a = $_ eq "-b" ? \@bcc : \@cc;
 797                 @$a = split /\s*,\s*/, shift @ARGV;
 798             }
 799             elsif (/-m/) {
 800                 $msg = shift @ARGV;
 801                 if ( $msg =~ /^-$/ ) {
 802                     undef $msg;
 803                     while (<STDIN>) { $msg .= $_ }
 804                 }
 805             }
 806             elsif (/-w/) { $wtime = shift @ARGV }
 807         }
 808         elsif (!$id && m|^(?:ticket/)?($idlist)$|) {
 809             $id = $1;
 810         }
 811         else {
 812             my $datum = /^-/ ? "option" : "argument";
 813             whine "Unrecognised $datum '$_'.";
 814             $bad = 1; last;
 815         }
 816     }
 817
 818     unless ($id) {
 819         whine "No object specified.";
 820         $bad = 1;
 821     }
 822     #return help($action, "ticket") if $bad;
 823     return suggest_help($action, "ticket") if $bad;
 824
 825     my $form = [
 826         "",
 827         [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Content-Type", "Text" ],
 828         {
 829             Ticket     => $id,
 830             Action     => $action,
 831             Cc         => [ @cc ],
 832             Bcc        => [ @bcc ],
 833             Attachment => [ @files ],
 834             TimeWorked => $wtime || '',
 835             'Content-Type' => $content_type || 'text/plain',
 836             Text       => $msg || '',
 837             Status => ''
 838         }
 839     ];
 840
 841     my $text = Form::compose([ $form ]);
 842
 843     if ($edit || !$msg) {
 844         my ($tmp) = vi_form_while(
 845             $text,
 846             sub {
 847                 my ($text, $form) = @_;
 848                 foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) {
 849                     return (0, "File '$f' doesn't exist") unless -f $f;
 850                 }
 851                 @files = @{ vsplit($form->[2]{'Attachment'}) };
 852                 return 1;
 853             },
 854         );
 855         return $tmp unless $tmp;
 856         $text = $tmp;
 857     }
 858
 859     my $i = 1;
 860     foreach my $file (@files) {
 861         $data{"attachment_$i"} = bless([ $file ], "Attachment");
 862         $i++;
 863     }
 864     $data{content} = $text;
 865
 866     my $r = submit("$REST/ticket/$id/comment", \%data);
 867     print $r->content;
 868     return 0;
 869 }
 870
 871 # Merge one ticket into another.
 872
 873 sub merge {
 874     my @id;
 875     my $bad = 0;
 876
 877     while (@ARGV) {
 878         $_ = shift @ARGV;
 879         s/^#// if /^#\d+/; # get rid of leading hash
 880
 881         if (/^\d+$/) {
 882             push @id, $_;
 883         }
 884         else {
 885             whine "Unrecognised argument: '$_'.";
 886             $bad = 1; last;
 887         }
 888     }
 889
 890     unless (@id == 2) {
 891         my $evil = @id > 2 ? "many" : "few";
 892         whine "Too $evil arguments specified.";
 893         $bad = 1;
 894     }
 895     #return help("merge", "ticket") if $bad;
 896     return suggest_help("merge", "ticket", $bad) if $bad;
 897
 898     my $r = submit("$REST/ticket/$id[0]/merge/$id[1]");
 899     print $r->content;
 900     return 0;
 901 }
 902
 903 # Link one ticket to another.
 904
 905 sub link {
 906     my ($bad, $del, %data) = (0, 0, ());
 907     my $type;
 908
 909     my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo
 910                                         ReferredToBy HasMember MemberOf);
 911
 912     while (@ARGV && $ARGV[0] =~ /^-/) {
 913         $_ = shift @ARGV;
 914
 915         if (/^-d$/) {
 916             $del = 1;
 917         }
 918         elsif (/^-t$/) {
 919             $bad = 1, last unless defined($type = get_type_argument());
 920         }
 921         else {
 922             whine "Unrecognised option: '$_'.";
 923             $bad = 1; last;
 924         }
 925     }
 926
 927     $type = "ticket" unless $type; # default type to tickets
 928
 929     if (@ARGV == 3) {
 930         my ($from, $rel, $to) = @ARGV;
 931         if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
 932             whine "Invalid link '$rel' for type $type specified.";
 933             $bad = 1;
 934         }
 935         %data = (id => $from, rel => $rel, to => $to, del => $del);
 936     }
 937     else {
 938         my $bad = @ARGV < 3 ? "few" : "many";
 939         whine "Too $bad arguments specified.";
 940         $bad = 1;
 941     }
 942     return suggest_help("link", $type, $bad) if $bad;
 943
 944     my $r = submit("$REST/$type/link", \%data);
 945     print $r->content;
 946     return 0;
 947 }
 948
 949 # Take/steal a ticket
 950 sub take {
 951     my ($cmd) = @_;
 952     my ($bad, %data) = (0, ());
 953
 954     my $id;
 955
 956     # get the ticket id
 957     if (@ARGV == 1) {
 958         ($id) = @ARGV;
 959         unless ($id =~ /^\d+$/) {
 960             whine "Invalid ticket ID $id specified.";
 961             $bad = 1;
 962         }
 963         my $form = [
 964             "",
 965             [ "Ticket", "Action" ],
 966             {
 967                 Ticket => $id,
 968                 Action => $cmd,
 969                 Status => '',
 970             }
 971         ];
 972
 973         my $text = Form::compose([ $form ]);
 974         $data{content} = $text;
 975     }
 976     else {
 977         $bad = @ARGV < 1 ? "few" : "many";
 978         whine "Too $bad arguments specified.";
 979         $bad = 1;
 980     }
 981     return suggest_help("take", "ticket", $bad) if $bad;
 982
 983     my $r = submit("$REST/ticket/$id/take", \%data);
 984     print $r->content;
 985     return 0;
 986 }
 987
 988 # Grant/revoke a user's rights.
 989
 990 sub grant {
 991     my ($cmd) = @_;
 992
 993     whine "$cmd is unimplemented.";
 994     return 1;
 995 }
 996
 997 # Client <-> Server communication.
 998 # --------------------------------
 999 #
1000 # This function composes and sends an HTTP request to the RT server, and
1001 # interprets the response. It takes a request URI, and optional request
1002 # data (a string, or a reference to a set of key-value pairs).
1003
1004 sub submit {
1005     my ($uri, $content) = @_;
1006     my ($req, $data);
1007     my $ua = LWP::UserAgent->new(agent => "RT/3.0b", env_proxy => 1);
1008     my $h = HTTP::Headers->new;
1009
1010     # Did the caller specify any data to send with the request?
1011     $data = [];
1012     if (defined $content) {
1013         unless (ref $content) {
1014             # If it's just a string, make sure LWP handles it properly.
1015             # (By pretending that it's a file!)
1016             $content = [ content => [undef, "", Content => $content] ];
1017         }
1018         elsif (ref $content eq 'HASH') {
1019             my @data;
1020             foreach my $k (keys %$content) {
1021                 if (ref $content->{$k} eq 'ARRAY') {
1022                     foreach my $v (@{ $content->{$k} }) {
1023                         push @data, $k, $v;
1024                     }
1025                 }
1026                 else { push @data, $k, $content->{$k} }
1027             }
1028             $content = \@data;
1029         }
1030         $data = $content;
1031     }
1032
1033     # Should we send authentication information to start a new session?
1034     my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted';
1035     (my $server = $config{server}) =~ s/^.*\/\/([^\/]+)\/?/$1/;
1036     if ($config{externalauth}) {
1037         $h->authorization_basic($config{user}, $config{passwd} || read_passwd() );
1038         print "   Password will be sent to $server $how\n",
1039               "   Press CTRL-C now if you do not want to continue\n"
1040             if ! $config{passwd};
1041     } elsif ( $no_strong_auth ) {
1042         if (!defined $session->cookie) {
1043             print "   Strong encryption not available, $no_strong_auth\n",
1044                   "   Password will be sent to $server $how\n",
1045                   "   Press CTRL-C now if you do not want to continue\n"
1046                 if ! $config{passwd};
1047             push @$data, ( user => $config{user} );
1048             push @$data, ( pass => $config{passwd} || read_passwd() );
1049         }
1050     }
1051
1052     # Now, we construct the request.
1053     if (@$data) {
1054         $req = POST($uri, $data, Content_Type => 'form-data');
1055     }
1056     else {
1057         $req = GET($uri);
1058     }
1059     $session->add_cookie_header($req);
1060     if ($config{externalauth}) {
1061         $req->header(%$h);
1062     }
1063
1064     # Then we send the request and parse the response.
1065     DEBUG(3, $req->as_string);
1066     my $res = $ua->request($req);
1067     DEBUG(3, $res->as_string);
1068
1069     if ($res->is_success) {
1070         # The content of the response we get from the RT server consists
1071         # of an HTTP-like status line followed by optional header lines,
1072         # a blank line, and arbitrary text.
1073
1074         my ($head, $text) = split /\n\n/, $res->content, 2;
1075         my ($status, @headers) = split /\n/, $head;
1076         $text =~ s/\n*$/\n/ if ($text);
1077
1078         # "RT/3.0.1 401 Credentials required"
1079         if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) {
1080             warn "rt: Malformed RT response from $config{server}.\n";
1081             warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3;
1082             exit -1;
1083         }
1084
1085         # Our caller can pretend that the server returned a custom HTTP
1086         # response code and message. (Doing that directly is apparently
1087         # not sufficiently portable and uncomplicated.)
1088         $res->code($1);
1089         $res->message($2);
1090         $res->content($text);
1091         $session->update($res) if ($res->is_success || $res->code != 401);
1092
1093         if (!$res->is_success) {
1094             # We can deal with authentication failures ourselves. Either
1095             # we sent invalid credentials, or our session has expired.
1096             if ($res->code == 401) {
1097                 my %d = @$data;
1098                 if (exists $d{user}) {
1099                     warn "rt: Incorrect username or password.\n";
1100                     exit -1;
1101                 }
1102                 elsif ($req->header("Cookie")) {
1103                     # We'll retry the request with credentials, unless
1104                     # we only wanted to logout in the first place.
1105                     $session->delete;
1106                     return submit(@_) unless $uri eq "$REST/logout";
1107                 }
1108             }
1109             # Conflicts should be dealt with by the handler and user.
1110             # For anything else, we just die.
1111             elsif ($res->code != 409) {
1112                 warn "rt: ", $res->content;
1113                 #exit;
1114             }
1115         }
1116     }
1117     else {
1118         warn "rt: Server error: ", $res->message, " (", $res->code, ")\n";
1119         exit -1;
1120     }
1121
1122     return $res;
1123 }
1124
1125 # Session management.
1126 # -------------------
1127 #
1128 # Maintains a list of active sessions in the ~/.rt_sessions file.
1129 {
1130     package Session;
1131     my ($s, $u);
1132
1133     # Initialises the session cache.
1134     sub new {
1135         my ($class, $file) = @_;
1136         my $self = {
1137             file => $file || "$HOME/.rt_sessions",
1138             sids => { }
1139         };
1140
1141         # The current session is identified by the currently configured
1142         # server and user.
1143         ($s, $u) = @config{"server", "user"};
1144
1145         bless $self, $class;
1146         $self->load();
1147
1148         return $self;
1149     }
1150
1151     # Returns the current session cookie.
1152     sub cookie {
1153         my ($self) = @_;
1154         my $cookie = $self->{sids}{$s}{$u};
1155         return defined $cookie ? "RT_SID_$cookie" : undef;
1156     }
1157
1158     # Deletes the current session cookie.
1159     sub delete {
1160         my ($self) = @_;
1161         delete $self->{sids}{$s}{$u};
1162     }
1163
1164     # Adds a Cookie header to an outgoing HTTP request.
1165     sub add_cookie_header {
1166         my ($self, $request) = @_;
1167         my $cookie = $self->cookie();
1168
1169         $request->header(Cookie => $cookie) if defined $cookie;
1170     }
1171
1172     # Extracts the Set-Cookie header from an HTTP response, and updates
1173     # session information accordingly.
1174     sub update {
1175         my ($self, $response) = @_;
1176         my $cookie = $response->header("Set-Cookie");
1177
1178         if (defined $cookie && $cookie =~ /^RT_SID_(.[^;,\s]+=[0-9A-Fa-f]+);/) {
1179             $self->{sids}{$s}{$u} = $1;
1180         }
1181     }
1182
1183     # Loads the session cache from the specified file.
1184     sub load {
1185         my ($self, $file) = @_;
1186         $file ||= $self->{file};
1187
1188         open( my $handle, '<', $file ) or return 0;
1189
1190         $self->{file} = $file;
1191         my $sids = $self->{sids} = {};
1192         while (<$handle>) {
1193             chomp;
1194             next if /^$/ || /^#/;
1195             next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
1196             my ($server, $user, $cookie) = split / /, $_;
1197             $sids->{$server}{$user} = $cookie;
1198         }
1199         return 1;
1200     }
1201
1202     # Writes the current session cache to the specified file.
1203     sub save {
1204         my ($self, $file) = shift;
1205         $file ||= $self->{file};
1206
1207         open( my $handle, '>', "$file" ) or return 0;
1208
1209         my $sids = $self->{sids};
1210         foreach my $server (keys %$sids) {
1211             foreach my $user (keys %{ $sids->{$server} }) {
1212                 my $sid = $sids->{$server}{$user};
1213                 if (defined $sid) {
1214                     print $handle "$server $user $sid\n";
1215                 }
1216             }
1217         }
1218         close($handle);
1219         chmod 0600, $file;
1220         return 1;
1221     }
1222
1223     sub DESTROY {
1224         my $self = shift;
1225         $self->save;
1226     }
1227 }
1228
1229 # Form handling.
1230 # --------------
1231 #
1232 # Forms are RFC822-style sets of (field, value) specifications with some
1233 # initial comments and interspersed blank lines allowed for convenience.
1234 # Sets of forms are separated by --\n (in a cheap parody of MIME).
1235 #
1236 # Each form is parsed into an array with four elements: commented text
1237 # at the start of the form, an array with the order of keys, a hash with
1238 # key/value pairs, and optional error text if the form syntax was wrong.
1239
1240 # Returns a reference to an array of parsed forms.
1241 sub Form::parse {
1242     my $state = 0;
1243     my @forms = ();
1244     my @lines = split /\n/, $_[0] if $_[0];
1245     my ($c, $o, $k, $e) = ("", [], {}, "");
1246
1247     LINE:
1248     while (@lines) {
1249         my $line = shift @lines;
1250
1251         next LINE if $line eq '';
1252
1253         if ($line eq '--') {
1254             # We reached the end of one form. We'll ignore it if it was
1255             # empty, and store it otherwise, errors and all.
1256             if ($e || $c || @$o) {
1257                 push @forms, [ $c, $o, $k, $e ];
1258                 $c = ""; $o = []; $k = {}; $e = "";
1259             }
1260             $state = 0;
1261         }
1262         elsif ($state != -1) {
1263             if ($state == 0 && $line =~ /^#/) {
1264                 # Read an optional block of comments (only) at the start
1265                 # of the form.
1266                 $state = 1;
1267                 $c = $line;
1268                 while (@lines && $lines[0] =~ /^#/) {
1269                     $c .= "\n".shift @lines;
1270                 }
1271                 $c .= "\n";
1272             }
1273             elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) {
1274                 # Read a field: value specification.
1275                 my $f  = $1;
1276                 my @v  = ($2 || ());
1277
1278                 # Read continuation lines, if any.
1279                 while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) {
1280                     push @v, shift @lines;
1281                 }
1282                 pop @v while (@v && $v[-1] eq '');
1283
1284                 # Strip longest common leading indent from text.
1285                 my $ws = "";
1286                 foreach my $ls (map {/^(\s+)/} @v[1..$#v]) {
1287                     $ws = $ls if (!$ws || length($ls) < length($ws));
1288                 }
1289                 s/^$ws// foreach @v;
1290
1291                 push(@$o, $f) unless exists $k->{$f};
1292                 vpush($k, $f, join("\n", @v));
1293
1294                 $state = 1;
1295             }
1296             elsif ($line !~ /^#/) {
1297                 # We've found a syntax error, so we'll reconstruct the
1298                 # form parsed thus far, and add an error marker. (>>)
1299                 $state = -1;
1300                 $e = Form::compose([[ "", $o, $k, "" ]]);
1301                 $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n";
1302             }
1303         }
1304         else {
1305             # We saw a syntax error earlier, so we'll accumulate the
1306             # contents of this form until the end.
1307             $e .= "$line\n";
1308         }
1309     }
1310     push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o);
1311
1312     foreach my $l (keys %$k) {
1313         $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY');
1314     }
1315
1316     return \@forms;
1317 }
1318
1319 # Returns text representing a set of forms.
1320 sub Form::compose {
1321     my ($forms) = @_;
1322     my @text;
1323
1324     foreach my $form (@$forms) {
1325         my ($c, $o, $k, $e) = @$form;
1326         my $text = "";
1327
1328         if ($c) {
1329             $c =~ s/\n*$/\n/;
1330             $text = "$c\n";
1331         }
1332         if ($e) {
1333             $text .= $e;
1334         }
1335         elsif ($o) {
1336             my @lines;
1337
1338             foreach my $key (@$o) {
1339                 my ($line, $sp);
1340                 my $v = $k->{$key};
1341                 my @values = ref $v eq 'ARRAY' ? @$v : $v;
1342
1343                 $sp = " "x(length("$key: "));
1344                 $sp = " "x4 if length($sp) > 16;
1345
1346                 foreach $v (@values) {
1347                     if ($v =~ /\n/) {
1348                         $v =~ s/^/$sp/gm;
1349                         $v =~ s/^$sp//;
1350
1351                         if ($line) {
1352                             push @lines, "$line\n\n";
1353                             $line = "";
1354                         }
1355                         elsif (@lines && $lines[-1] !~ /\n\n$/) {
1356                             $lines[-1] .= "\n";
1357                         }
1358                         push @lines, "$key: $v\n\n";
1359                     }
1360                     elsif ($line &&
1361                            length($line)+length($v)-rindex($line, "\n") >= 70)
1362                     {
1363                         $line .= ",\n$sp$v";
1364                     }
1365                     else {
1366                         $line = $line ? "$line,$v" : "$key: $v";
1367                     }
1368                 }
1369
1370                 $line = "$key:" unless @values;
1371                 if ($line) {
1372                     if ($line =~ /\n/) {
1373                         if (@lines && $lines[-1] !~ /\n\n$/) {
1374                             $lines[-1] .= "\n";
1375                         }
1376                         $line .= "\n";
1377                     }
1378                     push @lines, "$line\n";
1379                 }
1380             }
1381
1382             $text .= join "", @lines;
1383         }
1384         else {
1385             chomp $text;
1386         }
1387         push @text, $text;
1388     }
1389
1390     return join "\n--\n\n", @text;
1391 }
1392
1393 # Configuration.
1394 # --------------
1395
1396 # Returns configuration information from the environment.
1397 sub config_from_env {
1398     my %env;
1399
1400     foreach my $k (qw(EXTERNALAUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) {
1401
1402         if (exists $ENV{"RT$k"}) {
1403             $env{lc $k} = $ENV{"RT$k"};
1404         }
1405     }
1406
1407     return %env;
1408 }
1409
1410 # Finds a suitable configuration file and returns information from it.
1411 sub config_from_file {
1412     my ($rc) = @_;
1413
1414     if ($rc =~ m#^/#) {
1415         # We'll use an absolute path if we were given one.
1416         return parse_config_file($rc);
1417     }
1418     else {
1419         # Otherwise we'll use the first file we can find in the current
1420         # directory, or in one of its (increasingly distant) ancestors.
1421
1422         my @dirs = split /\//, cwd;
1423         while (@dirs) {
1424             my $file = join('/', @dirs, $rc);
1425             if (-r $file) {
1426                 return parse_config_file($file);
1427             }
1428
1429             # Remove the last directory component each time.
1430             pop @dirs;
1431         }
1432
1433         # Still nothing? We'll fall back to some likely defaults.
1434         for ("$HOME/$rc", "local/etc/rt.conf", "/etc/rt.conf") {
1435             return parse_config_file($_) if (-r $_);
1436         }
1437     }
1438
1439     return ();
1440 }
1441
1442 # Makes a hash of the specified configuration file.
1443 sub parse_config_file {
1444     my %cfg;
1445     my ($file) = @_;
1446     local $_; # $_ may be aliased to a constant, from line 1163
1447
1448     open( my $handle, '<', $file ) or return;
1449
1450     while (<$handle>) {
1451         chomp;
1452         next if (/^#/ || /^\s*$/);
1453
1454         if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
1455             $cfg{$1} = $2;
1456         }
1457         else {
1458             die "rt: $file:$.: unknown configuration directive.\n";
1459         }
1460     }
1461
1462     return %cfg;
1463 }
1464
1465 # Helper functions.
1466 # -----------------
1467
1468 sub whine {
1469     my $sub = (caller(1))[3];
1470     $sub =~ s/^main:://;
1471     warn "rt: $sub: @_\n";
1472     return 0;
1473 }
1474
1475 sub read_passwd {
1476     eval 'require Term::ReadKey';
1477     if ($@) {
1478         die "No password specified (and Term::ReadKey not installed).\n";
1479     }
1480
1481     print "Password: ";
1482     Term::ReadKey::ReadMode('noecho');
1483     chomp(my $passwd = Term::ReadKey::ReadLine(0));
1484     Term::ReadKey::ReadMode('restore');
1485     print "\n";
1486
1487     return $passwd;
1488 }
1489
1490 sub vi_form_while {
1491     my $text = shift;
1492     my $cb = shift;
1493
1494     my $error = 0;
1495     my ($c, $o, $k, $e);
1496     do {
1497         my $ntext = vi($text);
1498         return undef if ($error && $ntext eq $text);
1499
1500         $text = $ntext;
1501
1502         my $form = Form::parse($text);
1503         $error = 0;
1504         ($c, $o, $k, $e) = @{ $form->[0] };
1505         if ( $e ) {
1506             $error = 1;
1507             $c = "# Syntax error.";
1508             goto NEXT;
1509         }
1510         elsif (!@$o) {
1511             return 0;
1512         }
1513
1514         my ($status, $msg) = $cb->( $text, [$c, $o, $k, $e] );
1515         unless ( $status ) {
1516             $error = 1;
1517             $c = "# $msg";
1518         }
1519
1520     NEXT:
1521         $text = Form::compose([[$c, $o, $k, $e]]);
1522     } while ($error);
1523
1524     return $text;
1525 }
1526
1527 sub vi {
1528     my ($text) = @_;
1529     my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
1530
1531     local $/ = undef;
1532
1533     my $handle = File::Temp->new;
1534     print $handle $text;
1535     close($handle);
1536
1537     system($editor, $handle->filename) && die "Couldn't run $editor.\n";
1538
1539     open( $handle, '<', $handle->filename ) or die "$handle: $!\n";
1540     $text = <$handle>;
1541     close($handle);
1542
1543     return $text;
1544 }
1545
1546 # Add a value to a (possibly multi-valued) hash key.
1547 sub vpush {
1548     my ($hash, $key, $val) = @_;
1549     my @val = ref $val eq 'ARRAY' ? @$val : $val;
1550
1551     if (exists $hash->{$key}) {
1552         unless (ref $hash->{$key} eq 'ARRAY') {
1553             my @v = $hash->{$key} ne '' ? $hash->{$key} : ();
1554             $hash->{$key} = \@v;
1555         }
1556         push @{ $hash->{$key} }, @val;
1557     }
1558     else {
1559         $hash->{$key} = $val;
1560     }
1561 }
1562
1563 # "Normalise" a hash key that's known to be multi-valued.
1564 sub vsplit {
1565     my ($val) = @_;
1566     my ($word, @words);
1567     my @values = ref $val eq 'ARRAY' ? @$val : $val;
1568
1569     foreach my $line (map {split /\n/} @values) {
1570         # XXX: This should become a real parser, à la Text::ParseWords.
1571         $line =~ s/^\s+//;
1572         $line =~ s/\s+$//;
1573         my ( $a, $b ) = split /\s*,\s*/, $line, 2;
1574
1575         while ($a) {
1576             no warnings 'uninitialized';
1577             if ( $a =~ /^'/ ) {
1578                 my $s = $a;
1579                 while ( $a !~ /'$/ || (   $a !~ /(\\\\)+'$/
1580                             && $a =~ /(\\)+'$/ )) {
1581                     ( $a, $b ) = split /\s*,\s*/, $b, 2;
1582                     $s .= ',' . $a;
1583                 }
1584                 push @words, $s;
1585             }
1586             elsif ( $a =~ /^q\{/ ) {
1587                 my $s = $a;
1588                 while ( $a !~ /\}$/ ) {
1589                     ( $a, $b ) =
1590                       split /\s*,\s*/, $b, 2;
1591                     $s .= ',' . $a;
1592                 }
1593                 $s =~ s/^q\{/'/;
1594                 $s =~ s/\}/'/;
1595                 push @words, $s;
1596             }
1597             else {
1598                 push @words, $a;
1599             }
1600             ( $a, $b ) = split /\s*,\s*/, $b, 2;
1601         }
1602
1603
1604     }
1605
1606     return \@words;
1607 }
1608
1609 # WARN: this code is duplicated in lib/RT/Interface/REST.pm
1610 # change both functions at once
1611 sub expand_list {
1612     my ($list) = @_;
1613
1614     my @elts;
1615     foreach (split /\s*,\s*/, $list) {
1616         push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_;
1617     }
1618
1619     return map $_->[0], # schwartzian transform
1620         sort {
1621             defined $a->[1] && defined $b->[1]?
1622                 # both numbers
1623                 $a->[1] <=> $b->[1]
1624                 :!defined $a->[1] && !defined $b->[1]?
1625                     # both letters
1626                     $a->[2] cmp $b->[2]
1627                     # mix, number must be first
1628                     :defined $a->[1]? -1: 1
1629         }
1630         map [ $_, (defined( /^(\d+)$/ )? $1: undef), lc($_) ],
1631         @elts;
1632 }
1633
1634 sub get_type_argument {
1635     my $type;
1636
1637     if (@ARGV) {
1638         $type = shift @ARGV;
1639         unless ($type =~ /^[A-Za-z0-9_.-]+$/) {
1640             # We want whine to mention our caller, not us.
1641             @_ = ("Invalid type '$type' specified.");
1642             goto &whine;
1643         }
1644     }
1645     else {
1646         @_ = ("No type argument specified with -t.");
1647         goto &whine;
1648     }
1649
1650     $type =~ s/s$//; # "Plural". Ugh.
1651     return $type;
1652 }
1653
1654 sub get_var_argument {
1655     my ($data) = @_;
1656
1657     if (@ARGV) {
1658         my $kv = shift @ARGV;
1659         if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) {
1660             push @{ $data->{$k} }, $v;
1661         }
1662         else {
1663             @_ = ("Invalid variable specification: '$kv'.");
1664             goto &whine;
1665         }
1666     }
1667     else {
1668         @_ = ("No variable argument specified with -S.");
1669         goto &whine;
1670     }
1671 }
1672
1673 sub is_object_spec {
1674     my ($spec, $type) = @_;
1675
1676     $spec =~ s|^(?:$type/)?|$type/| if defined $type;
1677     return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o);
1678     return 0;
1679 }
1680
1681 sub suggest_help {
1682     my ($action, $type, $rv) = @_;
1683
1684     print STDERR "rt: For help, run 'rt help $action'.\n" if defined $action;
1685     print STDERR "rt: For help, run 'rt help $type'.\n" if defined $type;
1686     return $rv;
1687 }
1688
1689 sub str2time {
1690     # simplified procedure for parsing date, avoid loading Date::Parse
1691     my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May =>  4, Jun =>  5,
1692                  Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11);
1693     $_ = shift;
1694     my ($mon, $day, $hr, $min, $sec, $yr, $monstr);
1695     if ( /(\w{3})\s+(\d\d?)\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/ ) {
1696         ($monstr, $day, $hr, $min, $sec, $yr) = ($1, $2, $3, $4, $5, $6);
1697         $mon = $month{$monstr} if exists $month{$monstr};
1698     } elsif ( /(\d{4})-(\d\d)-(\d\d)\s+(\d\d):(\d\d):(\d\d)/ ) {
1699         ($yr, $mon, $day, $hr, $min, $sec) = ($1, $2-1, $3, $4, $5, $6);
1700     }
1701     if ( $yr and defined $mon and $day and defined $hr and defined $sec ) {
1702         return timelocal($sec,$min,$hr,$day,$mon,$yr);
1703     } else {
1704         print "Unknown date format in parsedate: $_\n";
1705         return undef;
1706     }
1707 }
1708
1709 sub date_diff {
1710     my ($old, $new) = @_;
1711     $new = time() if ! $new;
1712     $old = str2time($old) if $old !~ /^\d+$/;
1713     $new = str2time($new) if $new !~ /^\d+$/;
1714     return "???" if ! $old or ! $new;
1715
1716     my %seconds = (min => 60,
1717                    hr  => 60*60,
1718                    day => 60*60*24,
1719                    wk  => 60*60*24*7,
1720                    mth => 60*60*24*30,
1721                    yr  => 60*60*24*365);
1722
1723     my $diff = $new - $old;
1724     my $what = 'sec';
1725     my $howmuch = $diff;
1726     for ( sort {$seconds{$a} <=> $seconds{$b}} keys %seconds) {
1727         last if $diff < $seconds{$_};
1728         $what = $_;
1729         $howmuch = int($diff/$seconds{$_});
1730     }
1731     return "$howmuch $what";
1732 }
1733
1734 sub prettyshow {
1735     my $forms = shift;
1736     my ($form) = grep { exists $_->[2]->{Queue} } @$forms;
1737     my $k = $form->[2];
1738     # dates are in local time zone
1739     if ( $k ) {
1740         print "Date: $k->{Created}\n";
1741         print "From: $k->{Requestors}\n";
1742         print "Cc: $k->{Cc}\n" if $k->{Cc};
1743         print "X-AdminCc: $k->{AdminCc}\n" if $k->{AdminCc};
1744         print "X-Queue: $k->{Queue}\n";
1745         print "Subject: [rt #$k->{id}] $k->{Subject}\n\n";
1746     }
1747     # dates in these attributes are in GMT and will be converted
1748     foreach my $form (@$forms) {
1749         my ($c, $o, $k, $e) = @$form;
1750         next if ! $k->{id} or exists $k->{Queue};
1751         if ( exists $k->{Created} ) {
1752             my ($y,$m,$d,$hh,$mm,$ss) = ($k->{Created} =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/);
1753             $m--;
1754             my $created = localtime(timegm($ss,$mm,$hh,$d,$m,$y));
1755             if ( exists $k->{Description} ) {
1756                 print "===> $k->{Description} on $created\n";
1757             }
1758         }
1759         print "$k->{Content}\n" if exists $k->{Content} and
1760                                    $k->{Content} !~ /to have no content$/ and
1761                                    ($k->{Type}||'') ne 'EmailRecord';
1762         print "$k->{Attachments}\n" if exists $k->{Attachments} and
1763                                    $k->{Attachments};
1764     }
1765 }
1766
1767 sub prettylist {
1768     my $forms = shift;
1769     my $heading = "Ticket Owner Queue    Age   Told Status Requestor Subject\n";
1770     $heading .= '-' x 80 . "\n";
1771     my (@open, @me);
1772     foreach my $form (@$forms) {
1773         my ($c, $o, $k, $e) = @$form;
1774         next if ! $k->{id};
1775         print $heading if $heading;
1776         $heading = '';
1777         my $id = $k->{id};
1778         $id =~ s!^ticket/!!;
1779         my $owner = $k->{Owner} eq 'Nobody' ? '' : $k->{Owner};
1780         $owner = substr($owner, 0, 5);
1781         my $queue = substr($k->{Queue}, 0, 5);
1782         my $subject = substr($k->{Subject}, 0, 30);
1783         my $age = date_diff($k->{Created});
1784         my $told = $k->{Told} eq 'Not set' ? '' : date_diff($k->{Told});
1785         my $status = substr($k->{Status}, 0, 6);
1786         my $requestor = substr($k->{Requestors}, 0, 9);
1787         my $line = sprintf "%6s %5s %5s %6s %6s %-6s %-9s %-30s\n",
1788             $id, $owner, $queue, $age, $told, $status, $requestor, $subject;
1789         if ( $k->{Owner} eq 'Nobody' ) {
1790             push @open, $line;
1791         } elsif ($k->{Owner} eq $config{user} ) {
1792             push @me, $line;
1793         } else {
1794             print $line;
1795         }
1796     }
1797     print "No matches found\n" if $heading;
1798     printf "========== my %2d open tickets ==========\n", scalar @me if @me;
1799     print @me if @me;
1800     printf "========== %2d unowned tickets ==========\n", scalar @open if @open;
1801     print @open if @open;
1802 }
1803
1804 __DATA__
1805
1806 Title: intro
1807 Title: introduction
1808 Text:
1809
1810     This is a command-line interface to RT 3.0 or newer.
1811
1812     It allows you to interact with an RT server over HTTP, and offers an
1813     interface to RT's functionality that is better-suited to automation
1814     and integration with other tools.
1815
1816     In general, each invocation of this program should specify an action
1817     to perform on one or more objects, and any other arguments required
1818     to complete the desired action.
1819
1820     For more information:
1821
1822         - rt help usage         (syntax information)
1823         - rt help objects       (how to specify objects)
1824         - rt help actions       (a list of possible actions)
1825         - rt help types         (a list of object types)
1826
1827         - rt help config        (configuration details)
1828         - rt help examples      (a few useful examples)
1829         - rt help topics        (a list of help topics)
1830
1831 --
1832
1833 Title: usage
1834 Title: syntax
1835 Text:
1836
1837     Syntax:
1838
1839         rt <action> [options] [arguments]
1840       or
1841         rt shell
1842
1843     Each invocation of this program must specify an action (e.g. "edit",
1844     "create"), options to modify behaviour, and other arguments required
1845     by the specified action. (For example, most actions expect a list of
1846     numeric object IDs to act upon.)
1847
1848     The details of the syntax and arguments for each action are given by
1849     "rt help <action>". Some actions may be referred to by more than one
1850     name ("create" is the same as "new", for example).
1851
1852     You may also call "rt shell", which will give you an 'rt>' prompt at
1853     which you can issue commands of the form "<action> [options]
1854     [arguments]".  See "rt help shell" for details.
1855
1856     Objects are identified by a type and an ID (which can be a name or a
1857     number, depending on the type). For some actions, the object type is
1858     implied (you can only comment on tickets); for others, the user must
1859     specify it explicitly. See "rt help objects" for details.
1860
1861     In syntax descriptions, mandatory arguments that must be replaced by
1862     appropriate value are enclosed in <>, and optional arguments are
1863     indicated by [] (for example, <action> and [options] above).
1864
1865     For more information:
1866
1867         - rt help objects       (how to specify objects)
1868         - rt help actions       (a list of actions)
1869         - rt help types         (a list of object types)
1870         - rt help shell         (how to use the shell)
1871
1872 --
1873
1874 Title: conf
1875 Title: config
1876 Title: configuration
1877 Text:
1878
1879     This program has two major sources of configuration information: its
1880     configuration files, and the environment.
1881
1882     The program looks for configuration directives in a file named .rtrc
1883     (or $RTCONFIG; see below) in the current directory, and then in more
1884     distant ancestors, until it reaches /. If no suitable configuration
1885     files are found, it will also check for ~/.rtrc, local/etc/rt.conf
1886     and /etc/rt.conf.
1887
1888     Configuration directives:
1889
1890         The following directives may occur, one per line:
1891
1892         - server <URL>          URL to RT server.
1893         - user <username>       RT username.
1894         - passwd <passwd>       RT user's password.
1895         - query <RT Query>      Default RT Query for list action
1896         - orderby <order>       Default RT order for list action
1897         - queue <queuename>     Default RT Queue for list action
1898         - externalauth <0|1>    Use HTTP Basic authentication
1899          explicitely setting externalauth to 0 inhibits also GSSAPI based
1900          authentication, if LWP::Authen::Negotiate (and GSSAPI) is installed
1901
1902         Blank and #-commented lines are ignored.
1903
1904     Sample configuration file contents:
1905
1906          server  https://rt.somewhere.com/
1907          # more than one queue can be given (by adding a query expression)
1908          queue helpdesk or queue=support
1909          query Status != resolved and Owner=myaccount
1910
1911
1912     Environment variables:
1913
1914         The following environment variables override any corresponding
1915         values defined in configuration files:
1916
1917         - RTUSER
1918         - RTPASSWD
1919         - RTEXTERNALAUTH
1920         - RTSERVER
1921         - RTDEBUG       Numeric debug level. (Set to 3 for full logs.)
1922         - RTCONFIG      Specifies a name other than ".rtrc" for the
1923                         configuration file.
1924         - RTQUERY       Default RT Query for rt list
1925         - RTORDERBY     Default order for rt list
1926
1927 --
1928
1929 Title: objects
1930 Text:
1931
1932     Syntax:
1933
1934         <type>/<id>[/<attributes>]
1935
1936     Every object in RT has a type (e.g. "ticket", "queue") and a numeric
1937     ID. Some types of objects can also be identified by name (like users
1938     and queues). Furthermore, objects may have named attributes (such as
1939     "ticket/1/history").
1940
1941     An object specification is like a path in a virtual filesystem, with
1942     object types as top-level directories, object IDs as subdirectories,
1943     and named attributes as further subdirectories.
1944
1945     A comma-separated list of names, numeric IDs, or numeric ranges can
1946     be used to specify more than one object of the same type. Note that
1947     the list must be a single argument (i.e., no spaces). For example,
1948     "user/root,1-3,5,7-10,ams" is a list of ten users; the same list
1949     can also be written as "user/ams,root,1,2,3,5,7,8-10".
1950
1951     If just a number is given as object specification it will be
1952     interpreted as ticket/<number>
1953
1954     Examples:
1955
1956         1                   # the same as ticket/1
1957         ticket/1
1958         ticket/1/attachments
1959         ticket/1/attachments/3
1960         ticket/1/attachments/3/content
1961         ticket/1-3/links
1962         ticket/1-3,5-7/history
1963
1964         user/ams
1965
1966     For more information:
1967
1968         - rt help <action>      (action-specific details)
1969         - rt help <type>        (type-specific details)
1970
1971 --
1972
1973 Title: actions
1974 Title: commands
1975 Text:
1976
1977     You can currently perform the following actions on all objects:
1978
1979         - list          (list objects matching some condition)
1980         - show          (display object details)
1981         - edit          (edit object details)
1982         - create        (create a new object)
1983
1984     Each type may define actions specific to itself; these are listed in
1985     the help item about that type.
1986
1987     For more information:
1988
1989         - rt help <action>      (action-specific details)
1990         - rt help types         (a list of possible types)
1991
1992     The following actions on tickets are also possible:
1993
1994         - comment       Add comments to a ticket
1995         - correspond    Add comments to a ticket
1996         - merge         Merge one ticket into another
1997         - link          Link one ticket to another
1998         - take          Take a ticket (steal and untake are possible as well)
1999
2000     For several edit set subcommands that are frequently used abbreviations
2001     have been introduced. These abbreviations are:
2002
2003         - delete or del  delete a ticket           (edit set status=deleted)
2004         - resolve or res resolve a ticket          (edit set status=resolved)
2005         - subject        change subject of ticket  (edit set subject=string)
2006         - give           give a ticket to somebody (edit set owner=user)
2007
2008 --
2009
2010 Title: types
2011 Text:
2012
2013     You can currently operate on the following types of objects:
2014
2015         - tickets
2016         - users
2017         - groups
2018         - queues
2019
2020     For more information:
2021
2022         - rt help <type>        (type-specific details)
2023         - rt help objects       (how to specify objects)
2024         - rt help actions       (a list of possible actions)
2025
2026 --
2027
2028 Title: ticket
2029 Text:
2030
2031     Tickets are identified by a numeric ID.
2032
2033     The following generic operations may be performed upon tickets:
2034
2035         - list
2036         - show
2037         - edit
2038         - create
2039
2040     In addition, the following ticket-specific actions exist:
2041
2042         - link
2043         - merge
2044         - comment
2045         - correspond
2046         - take
2047         - steal
2048         - untake
2049         - give
2050         - resolve
2051         - delete
2052         - subject
2053
2054     Attributes:
2055
2056         The following attributes can be used with "rt show" or "rt edit"
2057         to retrieve or edit other information associated with tickets:
2058
2059         links                      A ticket's relationships with others.
2060         history                    All of a ticket's transactions.
2061         history/type/<type>        Only a particular type of transaction.
2062         history/id/<id>            Only the transaction of the specified id.
2063         attachments                A list of attachments.
2064         attachments/<id>           The metadata for an individual attachment.
2065         attachments/<id>/content   The content of an individual attachment.
2066
2067 --
2068
2069 Title: user
2070 Title: group
2071 Text:
2072
2073     Users and groups are identified by name or numeric ID.
2074
2075     The following generic operations may be performed upon them:
2076
2077         - list
2078         - show
2079         - edit
2080         - create
2081
2082 --
2083
2084 Title: queue
2085 Text:
2086
2087     Queues are identified by name or numeric ID.
2088
2089     Currently, they can be subjected to the following actions:
2090
2091         - show
2092         - edit
2093         - create
2094
2095 --
2096
2097 Title: subject
2098 Text:
2099
2100     Syntax:
2101
2102         rt subject <id> <new subject text>
2103
2104     Change the subject of a ticket whose ticket id is given.
2105
2106 --
2107
2108 Title: give
2109 Text:
2110
2111     Syntax:
2112
2113         rt give <id> <accountname>
2114
2115     Give a ticket whose ticket id is given to another user.
2116
2117 --
2118
2119 Title: steal
2120 Text:
2121
2122         rt steal <id>
2123
2124     Steal a ticket whose ticket id is given, i.e. set the owner to myself.
2125
2126 --
2127
2128 Title: take
2129 Text:
2130
2131     Syntax:
2132
2133         rt take <id>
2134
2135     Take a ticket whose ticket id is given, i.e. set the owner to myself.
2136
2137 --
2138
2139 Title: untake
2140 Text:
2141
2142     Syntax:
2143
2144         rt untake <id>
2145
2146     Untake a ticket whose ticket id is given, i.e. set the owner to Nobody.
2147
2148 --
2149
2150 Title: resolve
2151 Title: res
2152 Text:
2153
2154     Syntax:
2155
2156         rt resolve <id>
2157
2158     Resolves a ticket whose ticket id is given.
2159
2160 --
2161
2162 Title: delete
2163 Title: del
2164 Text:
2165
2166     Syntax:
2167
2168         rt delete <id>
2169
2170     Deletes a ticket whose ticket id is given.
2171
2172 --
2173
2174 Title: logout
2175 Text:
2176
2177     Syntax:
2178
2179         rt logout
2180
2181     Terminates the currently established login session. You will need to
2182     provide authentication credentials before you can continue using the
2183     server. (See "rt help config" for details about authentication.)
2184
2185 --
2186
2187 Title: ls
2188 Title: list
2189 Title: search
2190 Text:
2191
2192     Syntax:
2193
2194         rt <ls|list|search> [options] "query string"
2195
2196     Displays a list of objects matching the specified conditions.
2197     ("ls", "list", and "search" are synonyms.)
2198
2199     Conditions are expressed in the SQL-like syntax used internally by
2200     RT. (For more information, see "rt help query".) The query string
2201     must be supplied as one argument.
2202
2203     (Right now, the server doesn't support listing anything but tickets.
2204     Other types will be supported in future; this client will be able to
2205     take advantage of that support without any changes.)
2206
2207     Options:
2208
2209         The following options control how much information is displayed
2210         about each matching object:
2211
2212         -i             Numeric IDs only. (Useful for |rt edit -; see examples.)
2213         -s             Short description.
2214         -l             Longer description.
2215         -f <field[s]   Display only the fields listed and the ticket id
2216
2217         In addition,
2218
2219         -o +/-<field>  Orders the returned list by the specified field.
2220         -r             reversed order (useful if a default was given)
2221         -q queue[s]    restricts the query to the queue[s] given
2222                        multiple queues are separated by comma
2223         -S var=val     Submits the specified variable with the request.
2224         -t type        Specifies the type of object to look for. (The
2225                        default is "ticket".)
2226
2227     Examples:
2228
2229         rt ls "Priority > 5 and Status=new"
2230         rt ls -o +Subject "Priority > 5 and Status=new"
2231         rt ls -o -Created "Priority > 5 and Status=new"
2232         rt ls -i "Priority > 5"|rt edit - set status=resolved
2233         rt ls -t ticket "Subject like '[PATCH]%'"
2234         rt ls -q systems
2235         rt ls -f owner,subject
2236
2237 --
2238
2239 Title: show
2240 Text:
2241
2242     Syntax:
2243
2244         rt show [options] <object-ids>
2245
2246     Displays details of the specified objects.
2247
2248     For some types, object information is further classified into named
2249     attributes (for example, "1-3/links" is a valid ticket specification
2250     that refers to the links for tickets 1-3). Consult "rt help <type>"
2251     and "rt help objects" for further details.
2252
2253     If only a number is given it will be interpreted as the objects
2254     ticket/number and ticket/number/history
2255
2256     This command writes a set of forms representing the requested object
2257     data to STDOUT.
2258
2259     Options:
2260
2261         The following options control how much information is displayed
2262         about each matching object:
2263
2264         Without any formatting options prettyprinted output is generated.
2265         Giving any of the two options below reverts to raw output.
2266         -s      Short description (history and attachments only).
2267         -l      Longer description (history and attachments only).
2268
2269         In addition,
2270         -               Read IDs from STDIN instead of the command-line.
2271         -t type         Specifies object type.
2272         -f a,b,c        Restrict the display to the specified fields.
2273         -S var=val      Submits the specified variable with the request.
2274
2275     Examples:
2276
2277         rt show -t ticket -f id,subject,status 1-3
2278         rt show ticket/3/attachments/29
2279         rt show ticket/3/attachments/29/content
2280         rt show ticket/1-3/links
2281         rt show ticket/3/history
2282         rt show -l ticket/3/history
2283         rt show -t user 2
2284         rt show 2
2285
2286 --
2287
2288 Title: new
2289 Title: edit
2290 Title: create
2291 Text:
2292
2293     Syntax:
2294
2295         rt edit [options] <object-ids> set field=value [field=value] ...
2296                                        add field=value [field=value] ...
2297                                        del field=value [field=value] ...
2298
2299     Edits information corresponding to the specified objects.
2300
2301     A purely numeric object id nnn is translated into ticket/nnn
2302
2303     If, instead of "edit", an action of "new" or "create" is specified,
2304     then a new object is created. In this case, no numeric object IDs
2305     may be specified, but the syntax and behaviour remain otherwise
2306     unchanged.
2307
2308     This command typically starts an editor to allow you to edit object
2309     data in a form for submission. If you specified enough information
2310     on the command-line, however, it will make the submission directly.
2311
2312     The command line may specify field-values in three different ways.
2313     "set" sets the named field to the given value, "add" adds a value
2314     to a multi-valued field, and "del" deletes the corresponding value.
2315     Each "field=value" specification must be given as a single argument.
2316
2317     For some types, object information is further classified into named
2318     attributes (for example, "1-3/links" is a valid ticket specification
2319     that refers to the links for tickets 1-3). These attributes may also
2320     be edited. Consult "rt help <type>" and "rt help object" for further
2321     details.
2322
2323     Options:
2324
2325         -       Read numeric IDs from STDIN instead of the command-line.
2326                 (Useful with rt ls ... | rt edit -; see examples below.)
2327         -i      Read a completed form from STDIN before submitting.
2328         -o      Dump the completed form to STDOUT instead of submitting.
2329         -e      Allows you to edit the form even if the command-line has
2330                 enough information to make a submission directly.
2331         -S var=val
2332                 Submits the specified variable with the request.
2333         -t type Specifies object type.
2334         -ct content-type Specifies content type of message(tickets only).
2335
2336     Examples:
2337
2338         # Interactive (starts $EDITOR with a form).
2339         rt edit ticket/3
2340         rt create -t ticket
2341         rt create -t ticket -ct text/html
2342
2343         # Non-interactive.
2344         rt edit ticket/1-3 add cc=foo@example.com set priority=3 due=tomorrow
2345         rt ls -t tickets -i 'Priority > 5' | rt edit - set status=resolved
2346         rt edit ticket/4 set priority=3 owner=bar@example.com \
2347                          add cc=foo@example.com bcc=quux@example.net
2348         rt create -t ticket set subject='new ticket' priority=10 \
2349                             add cc=foo@example.com
2350
2351 --
2352
2353 Title: comment
2354 Title: correspond
2355 Text:
2356
2357     Syntax:
2358
2359         rt <comment|correspond> [options] <ticket-id>
2360
2361     Adds a comment (or correspondence) to the specified ticket (the only
2362     difference being that comments aren't sent to the requestors.)
2363
2364     This command will typically start an editor and allow you to type a
2365     comment into a form. If, however, you specified all the necessary
2366     information on the command line, it submits the comment directly.
2367
2368     (See "rt help forms" for more information about forms.)
2369
2370     Options:
2371
2372         -m <text>       Specify comment text.
2373         -ct <content-type> Specify content-type of comment text.
2374         -a <file>       Attach a file to the comment. (May be used more
2375                         than once to attach multiple files.)
2376         -c <addrs>      A comma-separated list of Cc addresses.
2377         -b <addrs>      A comma-separated list of Bcc addresses.
2378         -w <time>       Specify the time spent working on this ticket.
2379         -e              Starts an editor before the submission, even if
2380                         arguments from the command line were sufficient.
2381
2382     Examples:
2383
2384         rt comment -m 'Not worth fixing.' -a stddisclaimer.h 23
2385
2386 --
2387
2388 Title: merge
2389 Text:
2390
2391     Syntax:
2392
2393         rt merge <from-id> <to-id>
2394
2395     Merges the first ticket specified into the second ticket specified.
2396
2397 --
2398
2399 Title: link
2400 Text:
2401
2402     Syntax:
2403
2404         rt link [-d] <id-A> <link> <id-B>
2405
2406     Creates (or, with -d, deletes) a link between the specified tickets.
2407     The link can (irrespective of case) be any of:
2408
2409         DependsOn/DependedOnBy:     A depends upon B (or vice versa).
2410         RefersTo/ReferredToBy:      A refers to B (or vice versa).
2411         MemberOf/HasMember:         A is a member of B (or vice versa).
2412
2413     To view a ticket's links, use "rt show ticket/3/links". (See
2414     "rt help ticket" and "rt help show".)
2415
2416     Options:
2417
2418         -d      Deletes the specified link.
2419
2420     Examples:
2421
2422         rt link 2 dependson 3
2423         rt link -d 4 referredtoby 6     # 6 no longer refers to 4
2424
2425 --
2426
2427 Title: query
2428 Text:
2429
2430     RT uses an SQL-like syntax to specify object selection constraints.
2431     See the <RT:...> documentation for details.
2432
2433     (XXX: I'm going to have to write it, aren't I?)
2434
2435     Until it exists here a short description of important constructs:
2436
2437     The two simple forms of query expressions are the constructs
2438     Attribute like Value and
2439     Attribute = Value or Attribute != Value
2440
2441     Whether attributes can be matched using like or using = is built into RT.
2442     The attributes id, Queue, Owner Priority and Status require the = or !=
2443     tests.
2444
2445     If Value is a string it must be quoted and may contain the wildcard
2446     character %. If the string does not contain white space, the quoting
2447     may however be omitted, it will be added automatically when parsing
2448     the input.
2449
2450     Simple query expressions can be combined using and, or and parentheses
2451     can be used to group expressions.
2452
2453     As a special case a standalone string (which would not form a correct
2454     query) is transformed into (Owner='string' or Requestor like 'string%')
2455     and added to the default query, i.e. the query is narrowed down.
2456
2457     If no Queue=name clause is contained in the query, a default clause
2458     Queue=$config{queue} is added.
2459
2460     Examples:
2461     Status!='resolved' and Status!='rejected'
2462     (Owner='myaccount' or Requestor like 'myaccount%') and Status!='resolved'
2463
2464 --
2465
2466 Title: form
2467 Title: forms
2468 Text:
2469
2470     This program uses RFC822 header-style forms to represent object data
2471     in a form that's suitable for processing both by humans and scripts.
2472
2473     A form is a set of (field, value) specifications, with some initial
2474     commented text and interspersed blank lines allowed for convenience.
2475     Field names may appear more than once in a form; a comma-separated
2476     list of multiple field values may also be specified directly.
2477
2478     Field values can be wrapped as in RFC822, with leading whitespace.
2479     The longest sequence of leading whitespace common to all the lines
2480     is removed (preserving further indentation). There is no limit on
2481     the length of a value.
2482
2483     Multiple forms are separated by a line containing only "--\n".
2484
2485     (XXX: A more detailed specification will be provided soon. For now,
2486     the server-side syntax checking will suffice.)
2487
2488 --
2489
2490 Title: topics
2491 Text:
2492
2493     Syntax:
2494
2495         rt help <topic>
2496
2497     Get help on any of the following subjects:
2498
2499         - tickets, users, groups, queues.
2500         - show, edit, ls/list/search, new/create.
2501
2502         - query                                 (search query syntax)
2503         - forms                                 (form specification)
2504
2505         - objects                               (how to specify objects)
2506         - types                                 (a list of object types)
2507         - actions/commands                      (a list of actions)
2508         - usage/syntax                          (syntax details)
2509         - conf/config/configuration             (configuration details)
2510         - examples                              (a few useful examples)
2511
2512 --
2513
2514 Title: example
2515 Title: examples
2516 Text:
2517
2518     some useful examples
2519
2520     All the following list requests will be restricted to the default queue.
2521     That can be changed by adding the option -q queuename
2522
2523     List all tickets that are not rejected/resolved
2524         rt ls
2525     List all tickets that are new and do not have an owner
2526         rt ls "status=new and owner=nobody"
2527     List all tickets which I have sent or of which I am the owner
2528         rt ls myaccount
2529     List all attributes for the ticket 6977 (ls -l instead of ls)
2530         rt ls -l 6977
2531     Show the content of ticket 6977
2532         rt show 6977
2533     Show all attributes in the ticket and in the history of the ticket
2534         rt show -l 6977
2535     Comment a ticket (mail is sent to all queue watchers, i.e. AdminCc's)
2536         rt comment 6977
2537         This will open an editor and lets you add text (attribute Text:)
2538         Other attributes may be changed as well, but usually don't do that.
2539     Correspond a ticket (like comment, but mail is also sent to requestors)
2540         rt correspond 6977
2541     Edit a ticket (generic change, interactive using the editor)
2542         rt edit 6977
2543     Change the owner of a ticket non interactively
2544         rt edit 6977 set owner=myaccount
2545         or
2546         rt give 6977 account
2547         or
2548         rt take 6977
2549     Change the status of a ticket
2550         rt edit 6977 set status=resolved
2551         or
2552         rt resolve 6977
2553     Change the status of all tickets I own to resolved !!!
2554         rt ls -i owner=myaccount | rt edit - set status=resolved
2555
2556 --
2557
2558 Title: shell
2559 Text:
2560
2561     Syntax:
2562
2563         rt shell
2564
2565     Opens an interactive shell, at which you can issue commands of
2566     the form "<action> [options] [arguments]".
2567
2568     To exit the shell, type "quit" or "exit".
2569
2570     Commands can be given at the shell in the same form as they would
2571     be given at the command line without the leading 'rt' invocation.
2572
2573     Example:
2574         $ rt shell
2575         rt> create -t ticket set subject='new' add cc=foo@example.com
2576         # Ticket 8 created.
2577         rt> quit
2578         $
2579
2580 --
2581
2582 Title: take
2583 Title: untake
2584 Title: steal
2585 Text:
2586
2587     Syntax:
2588
2589         rt <take|untake|steal> <ticket-id>
2590
2591     Sets the owner of the specified ticket to the current user,
2592     assuming said user has the bits to do so, or releases the
2593     ticket.
2594
2595     'Take' is used on tickets which are not currently owned
2596     (Owner: Nobody), 'steal' is used on tickets which *are*
2597     currently owned, and 'untake' is used to "release" a ticket
2598     (reset its Owner to Nobody).  'Take' cannot be used on
2599     tickets which are currently owned.
2600
2601     Example:
2602         alice$ rt create -t ticket set subject="New ticket"
2603         # Ticket 7 created.
2604         alice$ rt take 7
2605         # Owner changed from Nobody to alice
2606         alice$ su bob
2607         bob$ rt steal 7
2608         # Owner changed from alice to bob
2609         bob$ rt untake 7
2610         # Owner changed from bob to Nobody
2611
2612 --
2613
2614 Title: quit
2615 Title: exit
2616 Text:
2617
2618     Use "quit" or "exit" to leave the shell.  Only valid within shell
2619     mode.
2620
2621     Example:
2622         $ rt shell
2623         rt> quit
2624         $
2625
2626 __END__
2627
2628 =head1 NAME
2629
2630 rt - command-line interface to RT 3.0 or newer
2631
2632 =head1 SYNOPSIS
2633
2634     rt help
2635
2636 =head1 DESCRIPTION
2637
2638 This script allows you to interact with an RT server over HTTP, and offers an
2639 interface to RT's functionality that is better-suited to automation and
2640 integration with other tools.
2641
2642 In general, each invocation of this program should specify an action to
2643 perform on one or more objects, and any other arguments required to complete
2644 the desired action.
2645