diff options
Diffstat (limited to 'rt/bin/rt.in')
| -rw-r--r-- | rt/bin/rt.in | 1816 |
1 files changed, 1816 insertions, 0 deletions
diff --git a/rt/bin/rt.in b/rt/bin/rt.in new file mode 100644 index 0000000..90369b5 --- /dev/null +++ b/rt/bin/rt.in @@ -0,0 +1,1816 @@ +#!@PERL@ -w +# BEGIN LICENSE BLOCK +# +# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> +# +# (Except where explictly superceded by other copyright notices) +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# Unless otherwise specified, all modifications, corrections or +# extensions to this work which alter its source code become the +# property of Best Practical Solutions, LLC when submitted for +# inclusion in the work. +# +# +# END LICENSE BLOCK + +use strict; + +# This program is intentionally written to have as few non-core module +# dependencies as possible. It should stay that way. + +use Cwd; +use LWP; +use HTTP::Request::Common; + +# We derive configuration information from hardwired defaults, dotfiles, +# and the RT* environment variables (in increasing order of precedence). +# Session information is stored in ~/.rt_sessions. + +my $VERSION = 0.02; +my $HOME = eval{(getpwuid($<))[7]} + || $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH} + || "."; +my %config = ( + ( + debug => 0, + user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME}, + passwd => undef, + server => 'http://localhost/rt/', + ), + config_from_file($ENV{RTCONFIG} || ".rtrc"), + config_from_env() +); +my $session = new Session("$HOME/.rt_sessions"); +my $REST = "$config{server}/REST/1.0"; + +sub whine; +sub DEBUG { warn @_ if $config{debug} >= shift } + +# These regexes are used by command handlers to parse arguments. +# (XXX: Ask Autrijus how i18n changes these definitions.) + +my $name = '[\w.-]+'; +my $field = '[a-zA-Z][a-zA-Z0-9_-]*'; +my $label = '[a-zA-Z0-9@_.+-]+'; +my $labels = "(?:$label,)*$label"; +my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+'; + +# Our command line looks like this: +# +# rt <action> [options] [arguments] +# +# We'll parse just enough of it to decide upon an action to perform, and +# leave the rest to per-action handlers to interpret appropriately. + +my %handlers = ( +# handler => [ ...aliases... ], + version => ["version", "ver"], + logout => ["logout"], + help => ["help", "man"], + show => ["show", "cat"], + edit => ["create", "edit", "new", "ed"], + list => ["search", "list", "ls"], + comment => ["comment", "correspond"], + link => ["link", "ln"], + merge => ["merge"], + grant => ["grant", "revoke"], +); + +# Once we find and call an appropriate handler, we're done. + +my (%actions, $action); +foreach my $fn (keys %handlers) { + foreach my $alias (@{ $handlers{$fn} }) { + $actions{$alias} = \&{"$fn"}; + } +} +if (@ARGV && exists $actions{$ARGV[0]}) { + $action = shift @ARGV; +} +$actions{$action || "help"}->($action || ()); +exit; + +# Handler functions. +# ------------------ +# +# The following subs are handlers for each entry in %actions. + +sub version { + print "rt $VERSION\n"; +} + +sub logout { + submit("$REST/logout") if defined $session->cookie; +} + +sub help { + my ($action, $type) = @_; + my (%help, $key); + + # What help topics do we know about? + local $/ = undef; + foreach my $item (@{ Form::parse(<DATA>) }) { + my $title = $item->[2]{Title}; + my @titles = ref $title eq 'ARRAY' ? @$title : $title; + + foreach $title (grep $_, @titles) { + $help{$title} = $item->[2]{Text}; + } + } + + # What does the user want help with? + undef $action if ($action && $actions{$action} eq \&help); + unless ($action || $type) { + # If we don't know, we'll look for clues in @ARGV. + foreach (@ARGV) { + if (exists $help{$_}) { $key = $_; last; } + } + unless ($key) { + # Tolerate possibly plural words. + foreach (@ARGV) { + if ($_ =~ s/s$// && exists $help{$_}) { $key = $_; last; } + } + } + } + + if ($type && $action) { + $key = "$type.$action"; + } + $key ||= $type || $action || "introduction"; + + # Find a suitable topic to display. + while (!exists $help{$key}) { + if ($type && $action) { + if ($key eq "$type.$action") { $key = $action; } + elsif ($key eq $action) { $key = $type; } + else { $key = "introduction"; } + } + else { + $key = "introduction"; + } + } + + print STDERR $help{$key}, "\n\n"; +} + +# Displays a list of objects that match some specified condition. + +sub list { + my ($q, $type, %data, $orderby); + my $bad = 0; + + while (@ARGV) { + $_ = shift @ARGV; + + if (/^-t$/) { + $bad = 1, last unless defined($type = get_type_argument()); + } + elsif (/^-S$/) { + $bad = 1, last unless get_var_argument(\%data); + } + elsif (/^-o$/) { + $orderby = shift @ARGV; + } + elsif (/^-([isl])$/) { + $data{format} = $1; + } + elsif (/^-f$/) { + if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) { + whine "No valid field list in '-f $ARGV[0]'."; + $bad = 1; last; + } + $data{fields} = shift @ARGV; + } + elsif (!defined $q && !/^-/) { + $q = $_; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } + + $type ||= "ticket"; + unless ($type && defined $q) { + my $item = $type ? "query string" : "object type"; + whine "No $item specified."; + $bad = 1; + } + return help("list", $type) if $bad; + + my $r = submit("$REST/search/$type", { query => $q, %data, orderby => $orderby || "" }); + print $r->content; +} + +# Displays selected information about a single object. + +sub show { + my ($type, @objects, %data); + my $slurped = 0; + my $bad = 0; + + while (@ARGV) { + $_ = shift @ARGV; + + if (/^-t$/) { + $bad = 1, last unless defined($type = get_type_argument()); + } + elsif (/^-S$/) { + $bad = 1, last unless get_var_argument(\%data); + } + elsif (/^-([isl])$/) { + $data{format} = $1; + } + elsif (/^-$/ && !$slurped) { + chomp(my @lines = <STDIN>); + foreach (@lines) { + unless (is_object_spec($_, $type)) { + whine "Invalid object on STDIN: '$_'."; + $bad = 1; last; + } + push @objects, $_; + } + $slurped = 1; + } + elsif (/^-f$/) { + if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) { + whine "No valid field list in '-f $ARGV[0]'."; + $bad = 1; last; + } + $data{fields} = shift @ARGV; + } + elsif (my $spec = is_object_spec($_, $type)) { + push @objects, $spec; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } + + unless (@objects) { + whine "No objects specified."; + $bad = 1; + } + return help("show", $type) if $bad; + + my $r = submit("$REST/show", { id => \@objects, %data }); + print $r->content; +} + +# To create a new object, we ask the server for a form with the defaults +# filled in, allow the user to edit it, and send the form back. +# +# To edit an object, we must ask the server for a form representing that +# object, make changes requested by the user (either on the command line +# or interactively via $EDITOR), and send the form back. + +sub edit { + my ($action) = @_; + my (%data, $type, @objects); + my ($cl, $text, $edit, $input, $output); + + use vars qw(%set %add %del); + %set = %add = %del = (); + my $slurped = 0; + my $bad = 0; + + while (@ARGV) { + $_ = shift @ARGV; + + if (/^-e$/) { $edit = 1 } + elsif (/^-i$/) { $input = 1 } + elsif (/^-o$/) { $output = 1 } + elsif (/^-t$/) { + $bad = 1, last unless defined($type = get_type_argument()); + } + elsif (/^-S$/) { + $bad = 1, last unless get_var_argument(\%data); + } + elsif (/^-$/ && !($slurped || $input)) { + chomp(my @lines = <STDIN>); + foreach (@lines) { + unless (is_object_spec($_, $type)) { + whine "Invalid object on STDIN: '$_'."; + $bad = 1; last; + } + push @objects, $_; + } + $slurped = 1; + } + elsif (/^set$/i) { + my $vars = 0; + + while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/) { + my ($key, $op, $val) = ($1, $2, $3); + my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del; + + vpush($hash, lc $key, $val); + shift @ARGV; + $vars++; + } + unless ($vars) { + whine "No variables to set."; + $bad = 1; last; + } + $cl = $vars; + } + elsif (/^(?:add|del)$/i) { + my $vars = 0; + my $hash = ($_ eq "add") ? \%add : \%del; + + while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/) { + my ($key, $val) = ($1, $2); + + vpush($hash, lc $key, $val); + shift @ARGV; + $vars++; + } + unless ($vars) { + whine "No variables to set."; + $bad = 1; last; + } + $cl = $vars; + } + elsif (my $spec = is_object_spec($_, $type)) { + push @objects, $spec; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } + + if ($action =~ /^ed(?:it)?$/) { + unless (@objects) { + whine "No objects specified."; + $bad = 1; + } + } + else { + if (@objects) { + whine "You shouldn't specify objects as arguments to $action."; + $bad = 1; + } + unless ($type) { + whine "What type of object do you want to create?"; + $bad = 1; + } + @objects = ("$type/new"); + } + return help($action, $type) if $bad; + + # We need a form to make changes to. We usually ask the server for + # one, but we can avoid that if we are fed one on STDIN, or if the + # user doesn't want to edit the form by hand, and the command line + # specifies only simple variable assignments. + + if ($input) { + local $/ = undef; + $text = <STDIN>; + } + elsif ($edit || %add || %del || !$cl) { + my $r = submit("$REST/show", { id => \@objects, format => 'l' }); + $text = $r->content; + } + + # If any changes were specified on the command line, apply them. + if ($cl) { + if ($text) { + # We're updating forms from the server. + my $forms = Form::parse($text); + + foreach my $form (@$forms) { + my ($c, $o, $k, $e) = @$form; + my ($key, $val); + + next if ($e || !@$o); + + local %add = %add; + local %del = %del; + local %set = %set; + + # Make changes to existing fields. + foreach $key (@$o) { + if (exists $add{lc $key}) { + $val = delete $add{lc $key}; + vpush($k, $key, $val); + $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/; + } + if (exists $del{lc $key}) { + $val = delete $del{lc $key}; + my %val = map {$_=>1} @{ vsplit($val) }; + $k->{$key} = vsplit($k->{$key}); + @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}}; + } + if (exists $set{lc $key}) { + $k->{$key} = delete $set{lc $key}; + } + } + + # Then update the others. + foreach $key (keys %set) { vpush($k, $key, $set{$key}) } + foreach $key (keys %add) { + vpush($k, $key, $add{$key}); + $k->{$key} = vsplit($k->{$key}); + } + push @$o, (keys %add, keys %set); + } + + $text = Form::compose($forms); + } + else { + # We're rolling our own set of forms. + my @forms; + foreach (@objects) { + my ($type, $ids, $args) = + m{^($name)/($idlist|$labels)(?:(/.*))?$}o; + + $args ||= ""; + foreach my $obj (expand_list($ids)) { + my %set = (%set, id => "$type/$obj$args"); + push @forms, ["", [keys %set], \%set]; + } + } + $text = Form::compose(\@forms); + } + } + + if ($output) { + print $text; + exit; + } + + my $synerr = 0; + +EDIT: + # We'll let the user edit the form before sending it to the server, + # unless we have enough information to submit it non-interactively. + if ($edit || (!$input && !$cl)) { + my $newtext = vi($text); + # We won't resubmit a bad form unless it was changed. + $text = ($synerr && $newtext eq $text) ? undef : $newtext; + } + + if ($text) { + my $r = submit("$REST/edit", {content => $text, %data}); + if ($r->code == 409) { + # If we submitted a bad form, we'll give the user a chance + # to correct it and resubmit. + if ($edit || (!$input && !$cl)) { + $text = $r->content; + $synerr = 1; + goto EDIT; + } + else { + print $r->content; + exit -1; + } + } + print $r->content; + } +} + +# We roll "comment" and "correspond" into the same handler. + +sub comment { + my ($action) = @_; + my (%data, $id, @files, @bcc, @cc, $msg, $wtime, $edit); + my $bad = 0; + + while (@ARGV) { + $_ = shift @ARGV; + + if (/^-e$/) { + $edit = 1; + } + elsif (/^-[abcmw]$/) { + unless (@ARGV) { + whine "No argument specified with $_."; + $bad = 1; last; + } + + if (/-a/) { + unless (-f $ARGV[0] && -r $ARGV[0]) { + whine "Cannot read attachment: '$ARGV[0]'."; + exit -1; + } + push @files, shift @ARGV; + } + elsif (/-([bc])/) { + my $a = $_ eq "-b" ? \@bcc : \@cc; + @$a = split /\s*,\s*/, shift @ARGV; + } + elsif (/-m/) { $msg = shift @ARGV } + elsif (/-w/) { $wtime = shift @ARGV } + } + elsif (!$id && m|^(?:ticket/)?($idlist)$|) { + $id = $1; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } + + unless ($id) { + whine "No object specified."; + $bad = 1; + } + return help($action, "ticket") if $bad; + + my $form = [ + "", + [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Text" ], + { + Ticket => $id, + Action => $action, + Cc => [ @cc ], + Bcc => [ @bcc ], + Attachment => [ @files ], + TimeWorked => $wtime || '', + Text => $msg || '', + } + ]; + + my $text = Form::compose([ $form ]); + + if ($edit || !$msg) { + my $error = 0; + my ($c, $o, $k, $e); + + do { + my $ntext = vi($text); + exit if ($error && $ntext eq $text); + $text = $ntext; + $form = Form::parse($text); + $error = 0; + + ($c, $o, $k, $e) = @{ $form->[0] }; + if ($e) { + $error = 1; + $c = "# Syntax error."; + goto NEXT; + } + elsif (!@$o) { + exit; + } + @files = @{ vsplit($k->{Attachment}) }; + + NEXT: + $text = Form::compose([[$c, $o, $k, $e]]); + } while ($error); + } + + my $i = 1; + foreach my $file (@files) { + $data{"attachment_$i"} = bless([ $file ], "Attachment"); + $i++; + } + $data{content} = $text; + + my $r = submit("$REST/ticket/comment/$id", \%data); + print $r->content; +} + +# Merge one ticket into another. + +sub merge { + my @id; + my $bad = 0; + + while (@ARGV) { + $_ = shift @ARGV; + + if (/^\d+$/) { + push @id, $_; + } + else { + whine "Unrecognised argument: '$_'."; + $bad = 1; last; + } + } + + unless (@id == 2) { + my $evil = @id > 2 ? "many" : "few"; + whine "Too $evil arguments specified."; + $bad = 1; + } + return help("merge", "ticket") if $bad; + + my $r = submit("$REST/ticket/merge/$id[0]", {into => $id[1]}); + print $r->content; +} + +# Link one ticket to another. + +sub link { + my ($bad, $del, %data) = (0, 0, ()); + my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo + ReferredToBy HasMember MemberOf); + + while (@ARGV && $ARGV[0] =~ /^-/) { + $_ = shift @ARGV; + + if (/^-d$/) { + $del = 1; + } + else { + whine "Unrecognised option: '$_'."; + $bad = 1; last; + } + } + + if (@ARGV == 3) { + my ($from, $rel, $to) = @ARGV; + if ($from !~ /^\d+$/ || $to !~ /^\d+$/) { + my $bad = $from =~ /^\d+$/ ? $to : $from; + whine "Invalid ticket ID '$bad' specified."; + $bad = 1; + } + unless (exists $ltypes{lc $rel}) { + whine "Invalid relationship '$rel' specified."; + $bad = 1; + } + %data = (id => $from, rel => $rel, to => $to, del => $del); + } + else { + my $bad = @ARGV < 3 ? "few" : "many"; + whine "Too $bad arguments specified."; + $bad = 1; + } + return help("link", "ticket") if $bad; + + my $r = submit("$REST/ticket/link", \%data); + print $r->content; +} + +# Grant/revoke a user's rights. + +sub grant { + my ($cmd) = @_; + + my $revoke = 0; + while (@ARGV) { + } + + $revoke = 1 if $cmd->{action} eq 'revoke'; +} + +# Client <-> Server communication. +# -------------------------------- +# +# This function composes and sends an HTTP request to the RT server, and +# interprets the response. It takes a request URI, and optional request +# data (a string, or a reference to a set of key-value pairs). + +sub submit { + my ($uri, $content) = @_; + my ($req, $data); + my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1); + + # Did the caller specify any data to send with the request? + $data = []; + if (defined $content) { + unless (ref $content) { + # If it's just a string, make sure LWP handles it properly. + # (By pretending that it's a file!) + $content = [ content => [undef, "", Content => $content] ]; + } + elsif (ref $content eq 'HASH') { + my @data; + foreach my $k (keys %$content) { + if (ref $content->{$k} eq 'ARRAY') { + foreach my $v (@{ $content->{$k} }) { + push @data, $k, $v; + } + } + else { push @data, $k, $content->{$k} } + } + $content = \@data; + } + $data = $content; + } + + # Should we send authentication information to start a new session? + if (!defined $session->cookie) { + push @$data, ( user => $config{user} ); + push @$data, ( pass => $config{passwd} || read_passwd() ); + } + + # Now, we construct the request. + if (@$data) { + $req = POST($uri, $data, Content_Type => 'form-data'); + } + else { + $req = GET($uri); + } + $session->add_cookie_header($req); + + # Then we send the request and parse the response. + DEBUG(3, $req->as_string); + my $res = $ua->request($req); + DEBUG(3, $res->as_string); + + if ($res->is_success) { + # The content of the response we get from the RT server consists + # of an HTTP-like status line followed by optional header lines, + # a blank line, and arbitrary text. + + my ($head, $text) = split /\n\n/, $res->content, 2; + my ($status, @headers) = split /\n/, $head; + $text =~ s/\n*$/\n/; + + # "RT/3.0.1 401 Credentials required" + if ($status !~ m#^RT/\d+(?:\.\d+)+(?:-?\w+)? (\d+) ([\w\s]+)$#) { + warn "rt: Malformed RT response from $config{server}.\n"; + warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3; + exit -1; + } + + # Our caller can pretend that the server returned a custom HTTP + # response code and message. (Doing that directly is apparently + # not sufficiently portable and uncomplicated.) + $res->code($1); + $res->message($2); + $res->content($text); + $session->update($res) if ($res->is_success || $res->code != 401); + + if (!$res->is_success) { + # We can deal with authentication failures ourselves. Either + # we sent invalid credentials, or our session has expired. + if ($res->code == 401) { + my %d = @$data; + if (exists $d{user}) { + warn "rt: Incorrect username or password.\n"; + exit -1; + } + elsif ($req->header("Cookie")) { + # We'll retry the request with credentials, unless + # we only wanted to logout in the first place. + $session->delete; + return submit(@_) unless $uri eq "$REST/logout"; + } + } + # Conflicts should be dealt with by the handler and user. + # For anything else, we just die. + elsif ($res->code != 409) { + warn "rt: ", $res->content; + exit; + } + } + } + else { + warn "rt: Server error: ", $res->message, " (", $res->code, ")\n"; + exit -1; + } + + return $res; +} + +# Session management. +# ------------------- +# +# Maintains a list of active sessions in the ~/.rt_sessions file. +{ + package Session; + my ($s, $u); + + # Initialises the session cache. + sub new { + my ($class, $file) = @_; + my $self = { + file => $file || "$HOME/.rt_sessions", + sids => { } + }; + + # The current session is identified by the currently configured + # server and user. + ($s, $u) = @config{"server", "user"}; + + bless $self, $class; + $self->load(); + + return $self; + } + + # Returns the current session cookie. + sub cookie { + my ($self) = @_; + my $cookie = $self->{sids}{$s}{$u}; + return defined $cookie ? "RT_SID=$cookie" : undef; + } + + # Deletes the current session cookie. + sub delete { + my ($self) = @_; + delete $self->{sids}{$s}{$u}; + } + + # Adds a Cookie header to an outgoing HTTP request. + sub add_cookie_header { + my ($self, $request) = @_; + my $cookie = $self->cookie(); + + $request->header(Cookie => $cookie) if defined $cookie; + } + + # Extracts the Set-Cookie header from an HTTP response, and updates + # session information accordingly. + sub update { + my ($self, $response) = @_; + my $cookie = $response->header("Set-Cookie"); + + if (defined $cookie && $cookie =~ /^RT_SID=([0-9A-Fa-f]+);/) { + $self->{sids}{$s}{$u} = $1; + } + } + + # Loads the session cache from the specified file. + sub load { + my ($self, $file) = @_; + $file ||= $self->{file}; + local *F; + + open(F, $file) && do { + $self->{file} = $file; + my $sids = $self->{sids} = {}; + while (<F>) { + chomp; + next if /^$/ || /^#/; + next unless m#^https?://[^ ]+ \w+ [0-9A-Fa-f]+$#; + my ($server, $user, $cookie) = split / /, $_; + $sids->{$server}{$user} = $cookie; + } + return 1; + }; + return 0; + } + + # Writes the current session cache to the specified file. + sub save { + my ($self, $file) = shift; + $file ||= $self->{file}; + local *F; + + open(F, ">$file") && do { + my $sids = $self->{sids}; + foreach my $server (keys %$sids) { + foreach my $user (keys %{ $sids->{$server} }) { + my $sid = $sids->{$server}{$user}; + if (defined $sid) { + print F "$server $user $sid\n"; + } + } + } + close(F); + chmod 0600, $file; + return 1; + }; + return 0; + } + + sub DESTROY { + my $self = shift; + $self->save; + } +} + +# Form handling. +# -------------- +# +# Forms are RFC822-style sets of (field, value) specifications with some +# initial comments and interspersed blank lines allowed for convenience. +# Sets of forms are separated by --\n (in a cheap parody of MIME). +# +# Each form is parsed into an array with four elements: commented text +# at the start of the form, an array with the order of keys, a hash with +# key/value pairs, and optional error text if the form syntax was wrong. + +# Returns a reference to an array of parsed forms. +sub Form::parse { + my $state = 0; + my @forms = (); + my @lines = split /\n/, $_[0]; + my ($c, $o, $k, $e) = ("", [], {}, ""); + + LINE: + while (@lines) { + my $line = shift @lines; + + next LINE if $line eq ''; + + if ($line eq '--') { + # We reached the end of one form. We'll ignore it if it was + # empty, and store it otherwise, errors and all. + if ($e || $c || @$o) { + push @forms, [ $c, $o, $k, $e ]; + $c = ""; $o = []; $k = {}; $e = ""; + } + $state = 0; + } + elsif ($state != -1) { + if ($state == 0 && $line =~ /^#/) { + # Read an optional block of comments (only) at the start + # of the form. + $state = 1; + $c = $line; + while (@lines && $lines[0] =~ /^#/) { + $c .= "\n".shift @lines; + } + $c .= "\n"; + } + elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) { + # Read a field: value specification. + my $f = $1; + my @v = ($2 || ()); + + # Read continuation lines, if any. + while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) { + push @v, shift @lines; + } + pop @v while (@v && $v[-1] eq ''); + + # Strip longest common leading indent from text. + my $ws = ""; + foreach my $ls (map {/^(\s+)/} @v[1..$#v]) { + $ws = $ls if (!$ws || length($ls) < length($ws)); + } + s/^$ws// foreach @v; + + push(@$o, $f) unless exists $k->{$f}; + vpush($k, $f, join("\n", @v)); + + $state = 1; + } + elsif ($line !~ /^#/) { + # We've found a syntax error, so we'll reconstruct the + # form parsed thus far, and add an error marker. (>>) + $state = -1; + $e = Form::compose([[ "", $o, $k, "" ]]); + $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n"; + } + } + else { + # We saw a syntax error earlier, so we'll accumulate the + # contents of this form until the end. + $e .= "$line\n"; + } + } + push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o); + + foreach my $l (keys %$k) { + $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY'); + } + + return \@forms; +} + +# Returns text representing a set of forms. +sub Form::compose { + my ($forms) = @_; + my @text; + + foreach my $form (@$forms) { + my ($c, $o, $k, $e) = @$form; + my $text = ""; + + if ($c) { + $c =~ s/\n*$/\n/; + $text = "$c\n"; + } + if ($e) { + $text .= $e; + } + elsif ($o) { + my @lines; + + foreach my $key (@$o) { + my ($line, $sp); + my $v = $k->{$key}; + my @values = ref $v eq 'ARRAY' ? @$v : $v; + + $sp = " "x(length("$key: ")); + $sp = " "x4 if length($sp) > 16; + + foreach $v (@values) { + if ($v =~ /\n/) { + $v =~ s/^/$sp/gm; + $v =~ s/^$sp//; + + if ($line) { + push @lines, "$line\n\n"; + $line = ""; + } + elsif (@lines && $lines[-1] !~ /\n\n$/) { + $lines[-1] .= "\n"; + } + push @lines, "$key: $v\n\n"; + } + elsif ($line && + length($line)+length($v)-rindex($line, "\n") >= 70) + { + $line .= ",\n$sp$v"; + } + else { + $line = $line ? "$line, $v" : "$key: $v"; + } + } + + $line = "$key:" unless @values; + if ($line) { + if ($line =~ /\n/) { + if (@lines && $lines[-1] !~ /\n\n$/) { + $lines[-1] .= "\n"; + } + $line .= "\n"; + } + push @lines, "$line\n"; + } + } + + $text .= join "", @lines; + } + else { + chomp $text; + } + push @text, $text; + } + + return join "\n--\n\n", @text; +} + +# Configuration. +# -------------- + +# Returns configuration information from the environment. +sub config_from_env { + my %env; + + foreach my $k ("DEBUG", "USER", "PASSWD", "SERVER") { + if (exists $ENV{"RT$k"}) { + $env{lc $k} = $ENV{"RT$k"}; + } + } + + return %env; +} + +# Finds a suitable configuration file and returns information from it. +sub config_from_file { + my ($rc) = @_; + + if ($rc =~ m#^/#) { + # We'll use an absolute path if we were given one. + return parse_config_file($rc); + } + else { + # Otherwise we'll use the first file we can find in the current + # directory, or in one of its (increasingly distant) ancestors. + + my @dirs = split /\//, cwd; + while (@dirs) { + my $file = join('/', @dirs, $rc); + if (-r $file) { + return parse_config_file($file); + } + + # Remove the last directory component each time. + pop @dirs; + } + + # Still nothing? We'll fall back to some likely defaults. + for ("$HOME/$rc", "/etc/rt.conf") { + return parse_config_file($_) if (-r $_); + } + } + + return (); +} + +# Makes a hash of the specified configuration file. +sub parse_config_file { + my %cfg; + my ($file) = @_; + + open(CFG, $file) && do { + while (<CFG>) { + chomp; + next if (/^#/ || /^\s*$/); + + if (/^(user|passwd|server)\s+([^ ]+)$/) { + $cfg{$1} = $2; + } + else { + die "rt: $file:$.: unknown configuration directive.\n"; + } + } + }; + + return %cfg; +} + +# Helper functions. +# ----------------- + +sub whine { + my $sub = (caller(1))[3]; + $sub =~ s/^main:://; + warn "rt: $sub: @_\n"; + return; +} + +sub read_passwd { + eval 'require Term::ReadKey'; + if ($@) { + die "No password specified (and Term::ReadKey not installed).\n"; + } + + print "Password: "; + Term::ReadKey::ReadMode('noecho'); + chomp(my $passwd = Term::ReadKey::ReadLine(0)); + Term::ReadKey::ReadMode('restore'); + print "\n"; + + return $passwd; +} + +sub vi { + my ($text) = @_; + my $file = "/tmp/rt.form.$$"; + my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi"; + + local *F; + local $/ = undef; + + open(F, ">$file") || die "$file: $!\n"; print F $text; close(F); + system($editor, $file) && die "Couldn't run $editor.\n"; + open(F, $file) || die "$file: $!\n"; $text = <F>; close(F); + unlink($file); + + return $text; +} + +# Add a value to a (possibly multi-valued) hash key. +sub vpush { + my ($hash, $key, $val) = @_; + my @val = ref $val eq 'ARRAY' ? @$val : $val; + + if (exists $hash->{$key}) { + unless (ref $hash->{$key} eq 'ARRAY') { + my @v = $hash->{$key} ne '' ? $hash->{$key} : (); + $hash->{$key} = \@v; + } + push @{ $hash->{$key} }, @val; + } + else { + $hash->{$key} = $val; + } +} + +# "Normalise" a hash key that's known to be multi-valued. +sub vsplit { + my ($val) = @_; + my ($word, @words); + my @values = ref $val eq 'ARRAY' ? @$val : $val; + + foreach my $line (map {split /\n/} @values) { + # XXX: This should become a real parser, à la Text::ParseWords. + $line =~ s/^\s+//; + $line =~ s/\s+$//; + push @words, split /\s*,\s*/, $line; + } + + return \@words; +} + +sub expand_list { + my ($list) = @_; + my ($elt, @elts, %elts); + + foreach $elt (split /,/, $list) { + if ($elt =~ /^(\d+)-(\d+)$/) { push @elts, ($1..$2) } + else { push @elts, $elt } + } + + @elts{@elts}=(); + return sort {$a<=>$b} keys %elts; +} + +sub get_type_argument { + my $type; + + if (@ARGV) { + $type = shift @ARGV; + unless ($type =~ /^[A-Za-z0-9_.-]+$/) { + # We want whine to mention our caller, not us. + @_ = ("Invalid type '$type' specified."); + goto &whine; + } + } + else { + @_ = ("No type argument specified with -t."); + goto &whine; + } + + $type =~ s/s$//; # "Plural". Ugh. + return $type; +} + +sub get_var_argument { + my ($data) = @_; + + if (@ARGV) { + my $kv = shift @ARGV; + if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) { + push @{ $data->{$k} }, $v; + } + else { + @_ = ("Invalid variable specification: '$kv'."); + goto &whine; + } + } + else { + @_ = ("No variable argument specified with -S."); + goto &whine; + } +} + +sub is_object_spec { + my ($spec, $type) = @_; + + $spec =~ s|^(?:$type/)?|$type/| if defined $type; + return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o); + return; +} + +__DATA__ + +Title: intro +Title: introduction +Text: + + ** THIS IS AN UNSUPPORTED PREVIEW RELEASE ** + ** PLEASE REPORT BUGS TO rt-bugs@fsck.com ** + + This is a command-line interface to RT 3. + + It allows you to interact with an RT server over HTTP, and offers an + interface to RT's functionality that is better-suited to automation + and integration with other tools. + + In general, each invocation of this program should specify an action + to perform on one or more objects, and any other arguments required + to complete the desired action. + + For more information: + + - rt help actions (a list of possible actions) + - rt help objects (how to specify objects) + - rt help usage (syntax information) + + - rt help config (configuration details) + - rt help examples (a few useful examples) + - rt help topics (a list of help topics) + +-- + +Title: usage +Title: syntax +Text: + + Syntax: + + rt <action> [options] [arguments] + + Each invocation of this program must specify an action (e.g. "edit", + "create"), options to modify behaviour, and other arguments required + by the specified action. (For example, most actions expect a list of + numeric object IDs to act upon.) + + The details of the syntax and arguments for each action are given by + "rt help <action>". Some actions may be referred to by more than one + name ("create" is the same as "new", for example). + + Objects are identified by a type and an ID (which can be a name or a + number, depending on the type). For some actions, the object type is + implied (you can only comment on tickets); for others, the user must + specify it explicitly. See "rt help objects" for details. + + In syntax descriptions, mandatory arguments that must be replaced by + appropriate value are enclosed in <>, and optional arguments are + indicated by [] (for example, <action> and [options] above). + + For more information: + + - rt help objects (how to specify objects) + - rt help actions (a list of actions) + - rt help types (a list of object types) + +-- + +Title: conf +Title: config +Title: configuration +Text: + + This program has two major sources of configuration information: its + configuration files, and the environment. + + The program looks for configuration directives in a file named .rtrc + (or $RTCONFIG; see below) in the current directory, and then in more + distant ancestors, until it reaches /. If no suitable configuration + files are found, it will also check for ~/.rtrc and /etc/rt.conf. + + Configuration directives: + + The following directives may occur, one per line: + + - server <URL> URL to RT server. + - user <username> RT username. + - passwd <passwd> RT user's password. + + Blank and #-commented lines are ignored. + + Environment variables: + + The following environment variables override any corresponding + values defined in configuration files: + + - RTUSER + - RTPASSWD + - RTSERVER + - RTDEBUG Numeric debug level. (Set to 3 for full logs.) + - RTCONFIG Specifies a name other than ".rtrc" for the + configuration file. + +-- + +Title: objects +Text: + + Syntax: + + <type>/<id>[/<attributes>] + + Every object in RT has a type (e.g. "ticket", "queue") and a numeric + ID. Some types of objects can also be identified by name (like users + and queues). Furthermore, objects may have named attributes (such as + "ticket/1/history"). + + An object specification is like a path in a virtual filesystem, with + object types as top-level directories, object IDs as subdirectories, + and named attributes as further subdirectories. + + A comma-separated list of names, numeric IDs, or numeric ranges can + be used to specify more than one object of the same type. Note that + the list must be a single argument (i.e., no spaces). For example, + "user/root,1-3,5,7-10,ams" is a list of ten users; the same list + can also be written as "user/ams,root,1,2,3,5,7,8-20". + + Examples: + + ticket/1 + ticket/1/attachments + ticket/1/attachments/3 + ticket/1/attachments/3/content + ticket/1-3/links + ticket/1-3,5-7/history + + user/ams + user/ams/rights + user/ams,rai,1/rights + + For more information: + + - rt help <action> (action-specific details) + - rt help <type> (type-specific details) + +-- + +Title: actions +Title: commands +Text: + + You can currently perform the following actions on all objects: + + - list (list objects matching some condition) + - show (display object details) + - edit (edit object details) + - create (create a new object) + + Each type may define actions specific to itself; these are listed in + the help item about that type. + + For more information: + + - rt help <action> (action-specific details) + - rt help types (a list of possible types) + +-- + +Title: types +Text: + + You can currently operate on the following types of objects: + + - tickets + - users + - groups + - queues + + For more information: + + - rt help <type> (type-specific details) + - rt help objects (how to specify objects) + - rt help actions (a list of possible actions) + +-- + +Title: ticket +Text: + + Tickets are identified by a numeric ID. + + The following generic operations may be performed upon tickets: + + - list + - show + - edit + - create + + In addition, the following ticket-specific actions exist: + + - link + - merge + - comment + - correspond + + Attributes: + + The following attributes can be used with "rt show" or "rt edit" + to retrieve or edit other information associated with tickets: + + links A ticket's relationships with others. + history All of a ticket's transactions. + history/type/<type> Only a particular type of transaction. + history/id/<id> Only the transaction of the specified id. + attachments A list of attachments. + attachments/<id> The metadata for an individual attachment. + attachments/<id>/content The content of an individual attachment. + +-- + +Title: user +Title: group +Text: + + Users and groups are identified by name or numeric ID. + + The following generic operations may be performed upon them: + + - list + - show + - edit + - create + + In addition, the following type-specific actions exist: + + - grant + - revoke + + Attributes: + + The following attributes can be used with "rt show" or "rt edit" + to retrieve or edit other information associated with users and + groups: + + rights Global rights granted to this user. + rights/<queue> Queue rights for this user. + +-- + +Title: queue +Text: + + Queues are identified by name or numeric ID. + + Currently, they can be subjected to the following actions: + + - show + - edit + - create + +-- + +Title: logout +Text: + + Syntax: + + rt logout + + Terminates the currently established login session. You will need to + provide authentication credentials before you can continue using the + server. (See "rt help config" for details about authentication.) + +-- + +Title: ls +Title: list +Title: search +Text: + + Syntax: + + rt <ls|list|search> [options] "query string" + + Displays a list of objects matching the specified conditions. + ("ls", "list", and "search" are synonyms.) + + Conditions are expressed in the SQL-like syntax used internally by + RT3. (For more information, see "rt help query".) The query string + must be supplied as one argument. + + (Right now, the server doesn't support listing anything but tickets. + Other types will be supported in future; this client will be able to + take advantage of that support without any changes.) + + Options: + + The following options control how much information is displayed + about each matching object: + + -i Numeric IDs only. (Useful for |rt edit -; see examples.) + -s Short description. + -l Longer description. + + In addition, + + -o +/-<field> Orders the returned list by the specified field. + -S var=val Submits the specified variable with the request. + -t type Specifies the type of object to look for. (The + default is "ticket".) + + Examples: + + rt ls "Priority > 5 and Status='new'" + rt ls -o +Subject "Priority > 5 and Status='new'" + rt ls -o -Created "Priority > 5 and Status='new'" + rt ls -i "Priority > 5"|rt edit - set status=resolved + rt ls -t ticket "Subject like '[PATCH]%'" + +-- + +Title: show +Text: + + Syntax: + + rt show [options] <object-ids> + + Displays details of the specified objects. + + For some types, object information is further classified into named + attributes (for example, "1-3/links" is a valid ticket specification + that refers to the links for tickets 1-3). Consult "rt help <type>" + and "rt help objects" for further details. + + This command writes a set of forms representing the requested object + data to STDOUT. + + Options: + + - Read IDs from STDIN instead of the command-line. + -t type Specifies object type. + -f a,b,c Restrict the display to the specified fields. + -S var=val Submits the specified variable with the request. + + Examples: + + rt show -t ticket -f id,subject,status 1-3 + rt show ticket/3/attachments/29 + rt show ticket/3/attachments/29/content + rt show ticket/1-3/links + rt show -t user 2 + +-- + +Title: new +Title: edit +Title: create +Text: + + Syntax: + + rt edit [options] <object-ids> set field=value [field=value] ... + add field=value [field=value] ... + del field=value [field=value] ... + + Edits information corresponding to the specified objects. + + If, instead of "edit", an action of "new" or "create" is specified, + then a new object is created. In this case, no numeric object IDs + may be specified, but the syntax and behaviour remain otherwise + unchanged. + + This command typically starts an editor to allow you to edit object + data in a form for submission. If you specified enough information + on the command-line, however, it will make the submission directly. + + The command line may specify field-values in three different ways. + "set" sets the named field to the given value, "add" adds a value + to a multi-valued field, and "del" deletes the corresponding value. + Each "field=value" specification must be given as a single argument. + + For some types, object information is further classified into named + attributes (for example, "1-3/links" is a valid ticket specification + that refers to the links for tickets 1-3). These attributes may also + be edited. Consult "rt help <type>" and "rt help object" for further + details. + + Options: + + - Read numeric IDs from STDIN instead of the command-line. + (Useful with rt ls ... | rt edit -; see examples below.) + -i Read a completed form from STDIN before submitting. + -o Dump the completed form to STDOUT instead of submitting. + -e Allows you to edit the form even if the command-line has + enough information to make a submission directly. + -S var=val + Submits the specified variable with the request. + -t type Specifies object type. + + Examples: + + # Interactive (starts $EDITOR with a form). + rt edit ticket/3 + rt create -t ticket + + # Non-interactive. + rt edit ticket/1-3 add cc=foo@example.com set priority=3 + rt ls -t tickets -i 'Priority > 5' | rt edit - set status=resolved + rt edit ticket/4 set priority=3 owner=bar@example.com \ + add cc=foo@example.com bcc=quux@example.net + rt create -t ticket subject='new ticket' priority=10 \ + add cc=foo@example.com + +-- + +Title: comment +Title: correspond +Text: + + Syntax: + + rt <comment|correspond> [options] <ticket-id> + + Adds a comment (or correspondence) to the specified ticket (the only + difference being that comments aren't sent to the requestors.) + + This command will typically start an editor and allow you to type a + comment into a form. If, however, you specified all the necessary + information on the command line, it submits the comment directly. + + (See "rt help forms" for more information about forms.) + + Options: + + -m <text> Specify comment text. + -a <file> Attach a file to the comment. (May be used more + than once to attach multiple files.) + -c <addrs> A comma-separated list of Cc addresses. + -b <addrs> A comma-separated list of Bcc addresses. + -w <time> Specify the time spent working on this ticket. + -e Starts an editor before the submission, even if + arguments from the command line were sufficient. + + Examples: + + rt comment -t 'Not worth fixing.' -a stddisclaimer.h 23 + +-- + +Title: merge +Text: + + Syntax: + + rt merge <from-id> <to-id> + + Merges the two specified tickets. + +-- + +Title: link +Text: + + Syntax: + + rt link [-d] <id-A> <relationship> <id-B> + + Creates (or, with -d, deletes) a link between the specified tickets. + The relationship can (irrespective of case) be any of: + + DependsOn/DependedOnBy: A depends upon B (or vice versa). + RefersTo/ReferredToBy: A refers to B (or vice versa). + MemberOf/HasMember: A is a member of B (or vice versa). + + To view a ticket's relationships, use "rt show ticket/3/links". (See + "rt help ticket" and "rt help show".) + + Options: + + -d Deletes the specified link. + + Examples: + + rt link 2 dependson 3 + rt link -d 4 referredtoby 6 # 6 no longer refers to 4 + +-- + +Title: grant +Title: revoke +Text: + +-- + +Title: query +Text: + + RT3 uses an SQL-like syntax to specify object selection constraints. + See the <RT:...> documentation for details. + + (XXX: I'm going to have to write it, aren't I?) + +-- + +Title: form +Title: forms +Text: + + This program uses RFC822 header-style forms to represent object data + in a form that's suitable for processing both by humans and scripts. + + A form is a set of (field, value) specifications, with some initial + commented text and interspersed blank lines allowed for convenience. + Field names may appear more than once in a form; a comma-separated + list of multiple field values may also be specified directly. + + Field values can be wrapped as in RFC822, with leading whitespace. + The longest sequence of leading whitespace common to all the lines + is removed (preserving further indentation). There is no limit on + the length of a value. + + Multiple forms are separated by a line containing only "--\n". + + (XXX: A more detailed specification will be provided soon. For now, + the server-side syntax checking will suffice.) + +-- + +Title: topics +Text: + + Use "rt help <topic>" for help on any of the following subjects: + + - tickets, users, groups, queues. + - show, edit, ls/list/search, new/create. + + - query (search query syntax) + - forms (form specification) + + - objects (how to specify objects) + - types (a list of object types) + - actions/commands (a list of actions) + - usage/syntax (syntax details) + - conf/config/configuration (configuration details) + - examples (a few useful examples) + +-- + +Title: example +Title: examples +Text: + + This section will be filled in with useful examples, once it becomes + more clear what examples may be useful. + + For the moment, please consult examples provided with each action. + +-- |