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