rt/bin/rt.in

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