X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Fbin%2Frt.in;h=d12460b06f9ed1899bdc52c4dda2b3f2d103d562;hb=ee27da6c4fdef689b9c32e9e84a7aa94648e2298;hp=90369b5b385eebabbc2b717d1620cc431ddc77b8;hpb=289340780927b5bac2c7604d7317c3063c6dd8cc;p=freeside.git diff --git a/rt/bin/rt.in b/rt/bin/rt.in deleted file mode 100644 index 90369b5b3..000000000 --- a/rt/bin/rt.in +++ /dev/null @@ -1,1816 +0,0 @@ -#!@PERL@ -w -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent -# -# (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 [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() }) { - 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 = ); - 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 = ); - 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 = ; - } - 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 () { - 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 () { - 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 = ; 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 [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 ". 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, 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 to RT server. - - user RT username. - - 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: - - /[/] - - 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-specific details) - - rt help (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-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-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/ Only a particular type of transaction. - history/id/ Only the transaction of the specified id. - attachments A list of attachments. - attachments/ The metadata for an individual attachment. - attachments//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 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 [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 +/- 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] - - 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 " - 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] 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 " 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 [options] - - 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 Specify comment text. - -a Attach a file to the comment. (May be used more - than once to attach multiple files.) - -c A comma-separated list of Cc addresses. - -b A comma-separated list of Bcc addresses. - -w