rt/bin/rt

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