diff options
Diffstat (limited to 'rt/bin')
-rwxr-xr-x | rt/bin/mason_handler.fcgi | 24 | ||||
-rw-r--r-- | rt/bin/mason_handler.fcgi.in | 24 | ||||
-rwxr-xr-x | rt/bin/mason_handler.scgi | 8 | ||||
-rw-r--r-- | rt/bin/mason_handler.scgi.in | 8 | ||||
-rw-r--r-- | rt/bin/mason_handler.svc | 2 | ||||
-rw-r--r-- | rt/bin/mason_handler.svc.in | 2 | ||||
-rwxr-xr-x | rt/bin/rt | 2901 | ||||
-rw-r--r-- | rt/bin/rt-crontool | 12 | ||||
-rw-r--r-- | rt/bin/rt-crontool.in | 12 | ||||
-rwxr-xr-x | rt/bin/rt-mailgate | 109 | ||||
-rw-r--r-- | rt/bin/rt-mailgate.in | 109 | ||||
-rw-r--r-- | rt/bin/rt.in | 1816 | ||||
-rwxr-xr-x | rt/bin/webmux.pl | 29 | ||||
-rw-r--r-- | rt/bin/webmux.pl.in | 29 |
14 files changed, 3773 insertions, 1312 deletions
diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi index 431eccb..93d1f88 100755 --- a/rt/bin/mason_handler.fcgi +++ b/rt/bin/mason_handler.fcgi @@ -27,7 +27,7 @@ use strict; use File::Basename; require ('/opt/rt3/bin/webmux.pl'); -my $h = &RT::Interface::Web::NewCGIHandler(); +my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters); # Enter CGI::Fast mode, which should also work as a vanilla CGI script. require CGI::Fast; @@ -44,11 +44,25 @@ while ( my $cgi = CGI::Fast->new ) { $ENV{'ENV'} = '' if defined $ENV{'ENV'}; $ENV{'IFS'} = '' if defined $ENV{'IFS'}; - unless ($h->interp->comp_exists($cgi->path_info)) { - $cgi->path_info($cgi->path_info . "/index.html"); + RT::ConnectToDatabase(); + + if ( ( !$h->interp->comp_exists( $cgi->path_info ) ) + && ( $h->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) { + $cgi->path_info( $cgi->path_info . "/index.html" ); + } + + eval { $h->handle_cgi_object($cgi); }; + if ($@) { + $RT::Logger->crit($@); + } + + + if ($RT::Handle->TransactionDepth) { + $RT::Handle->ForceRollback; + $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ; } - $h->handle_cgi_object($cgi); - # _should_ always be tied + + } 1; diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in index e932bfc..a009663 100644 --- a/rt/bin/mason_handler.fcgi.in +++ b/rt/bin/mason_handler.fcgi.in @@ -27,7 +27,7 @@ use strict; use File::Basename; require ('@RT_BIN_PATH@/webmux.pl'); -my $h = &RT::Interface::Web::NewCGIHandler(); +my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters); # Enter CGI::Fast mode, which should also work as a vanilla CGI script. require CGI::Fast; @@ -44,11 +44,25 @@ while ( my $cgi = CGI::Fast->new ) { $ENV{'ENV'} = '' if defined $ENV{'ENV'}; $ENV{'IFS'} = '' if defined $ENV{'IFS'}; - unless ($h->interp->comp_exists($cgi->path_info)) { - $cgi->path_info($cgi->path_info . "/index.html"); + RT::ConnectToDatabase(); + + if ( ( !$h->interp->comp_exists( $cgi->path_info ) ) + && ( $h->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) { + $cgi->path_info( $cgi->path_info . "/index.html" ); + } + + eval { $h->handle_cgi_object($cgi); }; + if ($@) { + $RT::Logger->crit($@); + } + + + if ($RT::Handle->TransactionDepth) { + $RT::Handle->ForceRollback; + $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ; } - $h->handle_cgi_object($cgi); - # _should_ always be tied + + } 1; diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi index 8e1135c..7774189 100755 --- a/rt/bin/mason_handler.scgi +++ b/rt/bin/mason_handler.scgi @@ -26,16 +26,18 @@ use strict; require ('/opt/rt3/bin/webmux.pl'); -my $h = &RT::Interface::Web::NewCGIHandler(); +my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters); require CGI; RT::Init(); my $cgi = CGI->new; -unless ($h->interp->comp_exists($cgi->path_info)) { - $cgi->path_info($cgi->path_info . "/index.html"); +if ( ( !$h->interp->comp_exists( $cgi->path_info ) ) + && ( $h->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) { + $cgi->path_info( $cgi->path_info . "/index.html" ); } + $h->handle_cgi_object($cgi); 1; diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in index 37d8380..614d4d4 100644 --- a/rt/bin/mason_handler.scgi.in +++ b/rt/bin/mason_handler.scgi.in @@ -26,16 +26,18 @@ use strict; require ('@RT_BIN_PATH@/webmux.pl'); -my $h = &RT::Interface::Web::NewCGIHandler(); +my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters); require CGI; RT::Init(); my $cgi = CGI->new; -unless ($h->interp->comp_exists($cgi->path_info)) { - $cgi->path_info($cgi->path_info . "/index.html"); +if ( ( !$h->interp->comp_exists( $cgi->path_info ) ) + && ( $h->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) { + $cgi->path_info( $cgi->path_info . "/index.html" ); } + $h->handle_cgi_object($cgi); 1; diff --git a/rt/bin/mason_handler.svc b/rt/bin/mason_handler.svc index e6d8378..c05d21e 100644 --- a/rt/bin/mason_handler.svc +++ b/rt/bin/mason_handler.svc @@ -197,7 +197,7 @@ BEGIN { warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n"; require CGI::Fast; -my $h = &RT::Interface::Web::NewCGIHandler(); +my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters); RT::Init(); diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in index cc12c0e..0ba1f51 100644 --- a/rt/bin/mason_handler.svc.in +++ b/rt/bin/mason_handler.svc.in @@ -197,7 +197,7 @@ BEGIN { warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n"; require CGI::Fast; -my $h = &RT::Interface::Web::NewCGIHandler(); +my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters); RT::Init(); @@ -1,1391 +1,1816 @@ -#!!!PERL!! -w -# -# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/rt,v 1.1 2002-08-12 06:17:07 ivan Exp $ -# RT is (c) 1996-2001 Jesse Vincent <jesse@bestpractical.com> +#!/usr/bin/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; -use Carp; -use Getopt::Long; -use lib "!!RT_LIB_PATH!!"; -use lib "!!RT_ETC_PATH!!"; +# 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; -use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect - GetCurrentUser GetMessageContent); +# Handler functions. +# ------------------ +# +# The following subs are handlers for each entry in %actions. -#Clean out all the nasties from the environment -CleanEnv(); +sub version { + print "rt $VERSION\n"; +} -#Load etc/config.pm and drop privs -LoadConfig(); +sub logout { + submit("$REST/logout") if defined $session->cookie; +} -#Connect to the database and get RT::SystemUser and RT::Nobody loaded -DBConnect(); +sub help { + my ($action, $type) = @_; + my (%help, $key); -#Drop setgid permissions -RT::DropSetGIDPermissions(); + # 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; -#Get the current user all loaded -my $CurrentUser = GetCurrentUser(); + foreach $title (grep $_, @titles) { + $help{$title} = $item->[2]{Text}; + } + } -unless ($CurrentUser->Id) { - print "No RT user found. Please consult your RT administrator.\n"; - exit(1); + # 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. -# {{{ commandline flags - -my ( @id, - @limit_queue, - @limit_status, - @limit_owner, - @limit_priority, - @limit_final_priority, - @limit_requestor, - @limit_subject, - @limit_body, - @limit_created, - @limit_resolved, - @limit_lastupdated, - @limit_dependson, - @limit_dependedonby, - @limit_memberof, - @limit_hasmember, - @limit_refersto, - @limit_referredtoby, - @limit_keyword, - - @limit_due, - @limit_starts, - @limit_started, - $limit_first, - $limit_rows, - $history, - $summary, - $create, - @requestors, - @cc, - @admincc, - $status, - $subject, - $owner, - $steal, - $queue, - $time_left, - $priority, - $final_priority, - $due, - $starts, - $started, - $contacted, - $comment, - $reply, - $source, - $edit, - @dependson, - @memberof, - @refersto, - $mergeinto, - @keywords, - $time_taken, - $verbose, - $debug, - $help, - $version); - -# }}} - -# Set defaults for cli args - -$edit = 1; # Assume the user wants to edit replies and comments - # unless they specify --noedit - -# {{{ args - -my @args =("id=s" => \@id, - "limit-queue=s" => \@limit_queue, - "limit-status=s" => \@limit_status, - "limit-owner=s" => \@limit_owner, - "limit-priority=s" => \@limit_priority, - "limit-final-priority=s" => \@limit_final_priority, - "limit-requestor=s" => \@limit_requestor, - "limit-subject=s" => \@limit_subject, - "limit-body=s", \@limit_body, - "limit-created=s" => \@limit_created, - "limit-due=s" => \@limit_due, - "limit-last-updated=s" => \@limit_lastupdated, - "limit-keyword=s" => \@limit_keyword, - - "limit-member-of=s" => \@limit_memberof, - "limit-has-member=s" => \@limit_hasmember, - "limit-depended-on-by=s" => \@limit_dependedonby, - "limit-depends-on=s" => \@limit_dependson, - "limit-referred-to-by=s" => \@limit_referredtoby, - "limit-refers-to=s" => \@limit_refersto, - - "limit-starts=s" => \@limit_starts, - "limit-started=s" => \@limit_started, - "limit-first=i" => \$limit_first, - "limit-rows=i" => \$limit_rows, - "history|show" => \$history, - "summary:s" => \$summary, - "create" => \$create, - "keywords=s" => \@keywords, - "requestor|requestors=s" => \@requestors, - "cc=s" => \@cc, - "admincc=s" => \@admincc, - "status=s" => \$status, - "subject=s" => \$subject, - "owner=s" => \$owner, - "steal" => \$steal, - "queue=s" => \$queue, - - - "priority=i" => \$priority, - "final-priority=i" => \$final_priority, - "due=s" => \$due, - "starts=s" => \$starts, - "started=s" => \$started, - "contacted=s" => \$contacted, - "comment", \$comment, - "reply|respond", \$reply, - "source=s" => \$source, - "edit!" => \$edit, - "depends-on=s" => \@dependson, - "member-of=s" => \@memberof, - "merge-into=s" => \$mergeinto, - "refers-to=s" => \@refersto, - "time-left=i" => \$time_left, - "time-taken=i" => \$time_taken, - "verbose+" => \$verbose, - "debug" => \$debug, - "version" => \$version, - "help|h|usage" => \$help - ); - -# }}} - - - -GetOptions(@args); - -print join(':',@keywords); -# {{{ If they want it, print a usage message and get out - -if ($help) { - - -print <<EOUSAGE; - -Limit the set of records returned: - ---id=[first][-][last] - Specify a single ticket, a range, or to start with (n-) or end with (-n) -a specific ticket. - - --limit-queue=<queue> - --limit-status=[!](new|open|stalled|resolved) - - --limit-owner=[!]<userid> - --limit-priority=[starts][-][ends] - --limit-final-priority=[starts][-][ends] - starts is less than ends - --limit-requestor=[!]<userid>|<email> - --limit-subject=[!]<text> - --limit-body=[!]<text> - --limit-keyword=[!]<select>/<keyword> - - Links - --limit-member-of=<ticketid> - --limit-has-member=<ticketid> - --limit-refers-to=<ticketid> - --limit-referred-to-by=<ticketid> - --limit-depends-on=<ticketid> - --limit-depended-on-by=<ticketid> +sub list { + my ($q, $type, %data, $orderby); + my $bad = 0; + while (@ARGV) { + $_ = shift @ARGV; - Dates - --limit-created=[starts][-][ends] - --limit-due=[starts][-][ends] - --limit-starts=[starts][-][ends] - --limit-started=[starts][-][ends] - --limit-resolved=[starts][-][ends] - --limit-last-updated=[starts][-][ends] - starts and ends are dates. starts can not be less than ends + 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; + } + } - --limit-first=<first row returned> - --limit-rows=<row count> + $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; - --history | --show - show a history of the tickets found - + my $r = submit("$REST/search/$type", { query => $q, %data, orderby => $orderby || "" }); + print $r->content; +} - --summary [format-string] - show a listing-style summary of the tickets found. If format string - is ommitted, uses \$RT_SUMMARY_FORMAT or an internal default - +# Displays selected information about a single object. - #TODO: doc summary - format: <atom>%<format> - atom: <name><size> - size: <integer> - name: (grep for # {{{ attribs for the array of ok values) +sub show { + my ($type, @objects, %data); + my $slurped = 0; + my $bad = 0; + while (@ARGV) { + $_ = shift @ARGV; - --create - create a new ticket. Any attributes that you can modify on an existing ticket - can also be used for ticket creation. + 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; +} -Attributes - Basics - --status=<new|open|stalled|resolved|dead> - sets status - --subject=<subject> - sets subject - --owner=<userid> - set owner to - --steal - Become the owner, even if someone else owns the ticket - --queue=<queueid> - set queue to - - --priority=<int> - - --final-priority=<int> +# 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; + } + } - Watchers - --requestors=[+|-]<userid|email address> - add or remove this user as a ticket requestor - --cc=[+|-]<userid|email address> - add or remove this user as a ticket cc - --admincc=[+|-]<userid|email address> - add or remove this user as a ticket admincc + 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; - (When creating tickets, just leave off the + or - ) + # 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. - Keywords - --keywords[+|-]<keyword_select>/<keyword> - Add or remove a keyword. + 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; + } - Dates - --due=<date> - --starts=<date> - --started=<date> - --contacted=<date> + my $synerr = 0; - --time-left=<int> - - --time-taken=<int> +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; + } +} - Link related manipulation: +# We roll "comment" and "correspond" into the same handler. - --depends-on=[+|-]<ticketid> - --member-of=[+|-]<ticketid> - --refers-to=[+|-]<ticketid> - --merge-into=<ticketid> +sub comment { + my ($action) = @_; + my (%data, $id, @files, @bcc, @cc, $msg, $wtime, $edit); + my $bad = 0; -Comments and replies + while (@ARGV) { + $_ = shift @ARGV; - --comment - --reply|respond - --source <path> - Specify the path to the source file for this ticket update + 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; + } + } - --noedit - Don't invoke \$EDITOR to edit the content of this update + 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. - Condiments +sub merge { + my @id; + my $bad = 0; - --verbose - --debug - --version - --help|h|usage - You're reading it. + while (@ARGV) { + $_ = shift @ARGV; -EOUSAGE + if (/^\d+$/) { + push @id, $_; + } + else { + whine "Unrecognised argument: '$_'."; + $bad = 1; last; + } + } - exit(0); -} + unless (@id == 2) { + my $evil = @id > 2 ? "many" : "few"; + whine "Too $evil arguments specified."; + $bad = 1; + } + return help("merge", "ticket") if $bad; -# Print version, and leave -if ($version) { - print "RT $RT::VERSION for $RT::rtname. Copyright 1996-2001 Jesse Vincent <jesse\@fsck.com>\n"; - exit(0); + my $r = submit("$REST/ticket/merge/$id[0]", {into => $id[1]}); + print $r->content; } -# }}} - -# {{{ Validate any options that were passed in. normalize them. +# Link one ticket to another. -#if a queue was specified -if ($queue) { - # make sure that $queue is a valid queue and load it into $queue_obj -} +sub link { + my ($bad, $del, %data) = (0, 0, ()); + my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo + ReferredToBy HasMember MemberOf); -#For each date in: $due, $starts, $started + while (@ARGV && $ARGV[0] =~ /^-/) { + $_ = shift @ARGV; -# load up an RT::Date object and parse it into a normalized form -# if it can't parse it, log an error and null out the variable + 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; -# {{{ Check if we're creating, if so, create the ticket and be done + my $r = submit("$REST/ticket/link", \%data); + print $r->content; +} -if ($create) { - $RT::Logger->debug("Creating a new ticket"); +# Grant/revoke a user's rights. - #Make sure the current user can create tickets in this queue - - #Make sure that the owner specified can own tickets in this queue +sub grant { + my ($cmd) = @_; + my $revoke = 0; + while (@ARGV) { + } - - my $linesref = GetMessageContent( Edit => $edit, Source => $source, - CurrentUser => $CurrentUser - ); - - require MIME::Entity; - my $MIMEObj; - - if ($linesref) { - $MIMEObj = MIME::Entity->build(Data => $linesref); - } - - use RT::Ticket; - my $Ticket=new RT::Ticket($CurrentUser); - my ($ticket, $trans, $msg) = - $Ticket->Create(Queue => $queue, - Owner => $owner, - Status => $status || 'new' , - Subject => $subject, - Requestor => \@requestors, - Cc => \@cc, - AdminCc => \@admincc, - Due => $due, - Starts => $starts, - Started => $started, - TimeLeft => $time_left, - InitialPriority => $priority, - FinalPriority => $final_priority, - MIMEObj => $MIMEObj - ); - print $msg . "\n"; + $revoke = 1 if $cmd->{action} eq 'revoke'; } -# }}} - -else { - #Apply restrictions - use RT::Tickets; - my $Tickets = new RT::Tickets($CurrentUser); - - # {{{ Limit our search - my $value; #to use when iterating through restrictions - my $queue_id; #to use when limiting by keyword - - # {{{ limit on id - - foreach $value (@id) { - if ($value =~ /^(\d+)$/) { - $Tickets->LimitId ( VALUE => $1, - OPERATOR => '='); - } - elsif ($value =~ /^(\d*)\D?(\d*)$/) { - my $start = $1; - my $end = $2; - $Tickets->LimitId( - VALUE => "$start", - OPERATOR => '>=') if ($start); - $Tickets->LimitId( - VALUE => "$end", - OPERATOR => '<=') if ($end); - } +# 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() ); + } - # }}} - - # {{{ limit on status - - foreach $value (@limit_status) { - if ($value =~ /^(=|!=|!|)(.*)$/) { - my $op = $1; - my $val = $2; - - - $op = ParseBooleanOp($op); - $Tickets->LimitStatus(VALUE => "$val", - OPERATOR => "$op"); - } + # 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; + } - # }}} - - - - # {{{ limit on queue - foreach $value (@limit_queue) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseBooleanOp($op); - - my $queue_obj = new RT::Queue($RT::SystemUser); - - unless ($queue_obj->Load($val)) { - $RT::Logger->debug("Queue '$val' not found"); - print STDERR "Queue '$val' not found\n"; - exit(-1); - } - $RT::Logger->debug ("Limiting queue to $op ".$queue_obj->Name); - $Tickets->LimitQueue(VALUE => $queue_obj->Name, - OPERATOR => $op); - $queue_id=$queue_obj->id; - } - } - - # {{{ limit on keyword - foreach $value (@limit_keyword) { - if ($value =~ /^(\W?)(.*?)\/(.*)$/i) { - my $op = $1; - my $select = $2; - my $keyword = $3; - - $op = ParseBooleanOp($op); - - # load the keyword select - my $keyselect = RT::KeywordSelect->new($RT::SystemUser); - unless ($keyselect->LoadByName(Name=>$select, Queue=>$queue_id)) { - $RT::Logger->debug("KeywordSelect '$select' not found"); - print STDERR "KeywordSelect '$select' not fount\n"; - exit(-1); - } - - # load the keyword - my $k = RT::Keyword->new($RT::SystemUser); - unless ($k->LoadByNameAndParentId($keyword, $keyselect->Keyword)) { - $RT::Logger->debug("Keyword '$keyword' not found"); - print STDERR "Keyword '$keyword' not found\n"; - exit(-1); - } - $Tickets->LimitKeyword(OPERATOR => $op, - KEYWORDSELECT => $keyselect->id, - KEYWORD => $k->id); - $RT::Logger->debug ("Limiting keyword to $op ".$k->Path); - } + # 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; + } + } } - # }}} - # {{{ limit on owner - foreach $value (@limit_owner) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseBooleanOp($op); - - my $user_obj = new RT::User($RT::SystemUser); - - unless ($user_obj->Load($val)) { - $RT::Logger->debug("User '$val' not found"); - print STDERR "User '$val' not found\n"; - exit(-1); - } - $val = $user_obj->id(); - - $RT::Logger->debug ("Limiting owner to $op $val"); - $Tickets->LimitOwner(VALUE => "$val", - OPERATOR => "$op"); - } - } - # }}} - # {{{ limt on priority - - foreach $value (@limit_priority) { - my ($start, $end) = ParseRange($value); - if ($start == $end) { - $Tickets->LimitPriority( VALUE => $start, - OPERATOR => '='); - } elsif ($start) { - $Tickets->LimitPriority( VALUE => $start, - OPERATOR => '>='); - } elsif ($end) { - $Tickets->LimitPriority( VALUE => $end, - OPERATOR => '<='); - } - + else { + warn "rt: Server error: ", $res->message, " (", $res->code, ")\n"; + exit -1; } - foreach $value (@limit_final_priority) { - my ($start, $end) = ParseRange($value); - if ($start == $end) { - $Tickets->LimitFinalPriority( VALUE => $start, - OPERATOR => '='); - } elsif ($start) { - $Tickets->LimitFinalPriority( VALUE => $start, - OPERATOR => '>='); - } elsif ($end) { - $Tickets->LimitFinalPriority( VALUE => $end, - OPERATOR => '<='); - } + + 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; } - # }}} - - foreach $value (@limit_requestor) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseBooleanOp($op); - $Tickets->LimitRequestor(VALUE => $val, - OPERATOR => $op ); - } - + + # Returns the current session cookie. + sub cookie { + my ($self) = @_; + my $cookie = $self->{sids}{$s}{$u}; + return defined $cookie ? "RT_SID=$cookie" : undef; } - foreach $value (@limit_subject) { - - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseLikeOp($op); - - $Tickets->LimitSubject(VALUE => $val, - OPERATOR => $op ); - } + + # Deletes the current session cookie. + sub delete { + my ($self) = @_; + delete $self->{sids}{$s}{$u}; } - - foreach $value (@limit_body) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseLikeOp($op); - - $Tickets->LimitBody(VALUE => $val, - OPERATOR => $op ); - } - + + # 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; } - - - - # Dates - foreach my $date (@limit_created) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitCreated ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitCreated ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + + # 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; + } } - foreach my $date (@limit_due) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitDue ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitDue ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + # 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; } - foreach my $date (@limit_starts) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitStarts ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitStarts ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + # 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; } - foreach my $date (@limit_started) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitStarted ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitStarted ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + sub DESTROY { + my $self = shift; + $self->save; } +} - foreach my $date (@limit_resolved) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitResolved ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitResolved ( VALUE => $end, - OPERATOR => '<=' ) if ($end); +# 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 $date (@limit_lastupdated) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitLastUpdated( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitLastUpdated ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + foreach my $l (keys %$k) { + $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY'); } - foreach my $link (@limit_memberof) { - $Tickets->LimitMemberOf($link); - } + return \@forms; +} - foreach my $link (@limit_hasmember) { - $Tickets->LimitHasMember($link); - } +# Returns text representing a set of forms. +sub Form::compose { + my ($forms) = @_; + my @text; - foreach my $link (@limit_dependson) { - $Tickets->LimitDependsOn($link); - } + foreach my $form (@$forms) { + my ($c, $o, $k, $e) = @$form; + my $text = ""; - foreach my $link (@limit_dependedonby) { - $Tickets->LimitDependedOnBy($link); + 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; } - foreach my $link (@limit_refersto) { - $Tickets->LimitRefersTo($link); - } - - foreach my $link (@limit_referredtoby) { - $Tickets->LimitReferredToBy($link); - } - - if ($limit_first){ - } - if ($limit_rows){ - } + return join "\n--\n\n", @text; +} -# }}} - - # {{{ Iterate through all tickets we found +# Configuration. +# -------------- +# Returns configuration information from the environment. +sub config_from_env { + my %env; - my ($format, $titles, $code); - - #Set up the summary format if we need to - if (defined $summary) { - my $format_string = $summary || $ENV{'RT_SUMMARY_FORMAT'} || "%id4%status4%queue7%subject40%requestor16"; + foreach my $k ("DEBUG", "USER", "PASSWD", "SERVER") { + if (exists $ENV{"RT$k"}) { + $env{lc $k} = $ENV{"RT$k"}; + } + } - ($format, $titles, $code) = BuildListingFormat($format_string); - printf "$format\n", eval "$titles"; - } + return %env; +} - +# Finds a suitable configuration file and returns information from it. +sub config_from_file { + my ($rc) = @_; - while (my $Ticket = $Tickets->Next()) { - $RT::Logger->debug ("Now working on ticket ". $Ticket->id); - - #Run through all the ticket modifications we might want to do - #TODO: these are all insufficiently lazy and should be replaced with some - # nice foreaches. - - - # {{{ deal with watchers - - # add / delete requestors - foreach $value (@requestors) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $addr = $2; - - $Ticket->AddRequestor(Email => $addr) if ($op eq '+'); - $Ticket->DeleteRequestor( $addr) if ($op eq '-'); - } - } - - # add / delete ccs - foreach $value (@cc) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $addr = $2; - $Ticket->AddCc(Email => $addr) if ($op eq '+'); - $Ticket->DeleteCc($addr) if ($op eq '-'); - } - } - - # add / delete adminccs - $RT::Logger->debug("Looking at admin ccs"); - foreach $value (@admincc) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $addr = $2; - $Ticket->AddAdminCc(Email => $addr) if ($op eq '+'); - $Ticket->DeleteAdminCc($addr) if ($op eq '-'); - } - } - - # }}} - - # {{{ Deal with ticket keywords - - my $KeywordSelects = $Ticket->QueueObj->KeywordSelects(); - $RT::Logger->debug ("Looking at keywords"); - foreach $value (@keywords) { - $RT::Logger->debug("Looking at --keyword=$value"); - if ($value =~ /^(\W?)(.*?)\/(.*)$/) { - my $op = $1; - my $select = $2; - my $keyword = $3; - - $RT::Logger->debug("Going to $op Keyword $select / $keyword"); - while (my $ks = $KeywordSelects->Next) { - $RT::Logger->debug("$select is select ".$ks->Name." is found"); - next unless ($ks->Name =~ /$select/i); - $RT::Logger->debug ("Found a match for $select\n"); - my $kids = $ks->KeywordObj->Descendents; - - my ($kid); - foreach $kid (keys %{$kids}) { - $RT::Logger->debug("Now comparing $keyword with ".$kids->{$kid}. "\n"); - next unless ($kids->{$kid} =~ /^$keyword$/i); - $RT::Logger->debug("Going to $op $select / $keyword (".$kids->{$kid} .")"); - $Ticket->DeleteKeyword(KeywordSelect => $ks->id, - Keyword => $kid) if ($op eq '-'); - - $Ticket->AddKeyword(KeywordSelect => $ks->id, - Keyword => $kid) if ($op eq '+'); - } - - } - } - } - # }}} - - # {{{ deal with links - - # Deal with merging { - if ($mergeinto) { - my ($trans, $msg) =$Ticket->MergeInto($mergeinto); - print $msg."\n"; - } - # add /delete depends-ons - - foreach my $value (@dependson) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $ticket = $2; - if (!$op or ($op eq '+')) { - my ($trans, $msg) = - $Ticket->AddLink(Type => 'DependsOn', Target => $ticket); - print $msg."\n"; - } - elsif ($op eq '-') { - my ($trans, $msg) = - $Ticket->DeleteLink(Type => 'DependsOn', Target => $ticket); - print $msg."\n"; - } - - } - } - # add /delete member-of - foreach my $value (@memberof) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $ticket = $2; - if ($op eq '+') { - my ($trans, $msg) = - $Ticket->AddLink(Type => 'MemberOf', Target => $ticket); - print $msg; - } - elsif ($op eq '-') { - my ($trans, $msg) = - $Ticket->DeleteLink(Type => 'MemberOf', Target => $ticket); - print $msg; - } - - } - } - # add / delete refers-to - foreach my $value (@refersto) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $ticket = $2; - if ($op eq '+') { - my ($trans, $msg) = - $Ticket->AddLink(Type => 'RefersTo', Target => $ticket); - print $msg; - } - elsif ($op eq '-') { - my ($trans, $msg) = - $Ticket->DeleteLink(Type => 'RefersTo', Target => $ticket); - print $msg; - } - - } - } - - # }}} - - # {{{ deal with dates - - #set due - if ($due) { - my $iso = ParseDateToISO($due); - if ($iso) { - $RT::Logger->debug("Setting due date to $iso ($due)"); - my ($trans, $msg) = - $Ticket->SetDue($iso); - print $msg; - } - else { - print "Due date '$due' could not be parsed"; - } - } - - #set starts - if ($starts) { - my $iso = ParseDateToISO($due); - if ($iso) { - my ($trans, $msg) = - $Ticket->SetStarts($iso); - print $msg."\n"; - } - else { - print "Starts date '$starts' could not be parsed"; - } - } - #set started - if ($started) { - my $iso = ParseDateToISO($started); - if ($iso) { - my ($trans, $msg) = - $Ticket->SetStarted($iso); - print $msg."\n"; - } - else { - print "Started date '$started' could not be parsed"; - } - } - #set contacted - if ($contacted) { - my $iso = ParseDateToISO($contacted); - if ($iso) { - my ($trans, $msg) = - $Ticket->SetContacted($iso); - print $msg."\n"; - } - else { - print "Contacted date '$contacted' could not be parsed"; - } - } - - # }}} - - # {{{ set other attributes - - #Set subject - if ($subject) { - my ($trans, $msg) = $Ticket->SetSubject($subject); - print $msg."\n"; - } - - #Set priority - if ($priority) { - my ($trans, $msg) = - $Ticket->SetPriority($priority); - print $msg."\n"; - } - - #Set final priority - if ($final_priority) { - my ($trans, $msg) = - $Ticket->SetFinalPriority($final_priority); - print $msg."\n"; - } - - #Set status - if ($status) { - my ($trans, $msg) = - $Ticket->SetStatus($status); - print $msg."\n"; - } - - #Set time left - if ($time_left) { - my ($trans, $msg) = - $Ticket->SetTimeLeft($time_left); - print $msg."\n"; - } - - #Set time_taken - if ($time_taken) { - my ($trans, $msg) = - $Ticket->SetTimeTaken($time_taken); - print $msg."\n"; - } - - #Set owner - if ($owner) { - my ($trans, $msg) = - $Ticket->SetOwner($owner); - print $msg."\n"; - } - - # Steal - if ($steal) { - my ($trans, $msg) = - $Ticket->Steal(); - print $msg . "\n"; + 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 $_); } - #Set queue - if ($queue) { - my ($trans, $msg) = - $Ticket->SetQueue($queue); - print $msg."\n"; - } - - # }}} - - - - # {{{ Perform ticket comments/replies - if ($reply) { - $RT::Logger->debug("Replying to ticket ".$Ticket->Id); - - my $linesref = GetMessageContent( Edit => $edit, Source => $source, - CurrentUser => $CurrentUser - ); - - #TODO build this entity - require MIME::Entity; - my $MIMEObj = MIME::Entity->build(Data => $linesref); - - $Ticket->Correspond( MIMEObj => $MIMEObj , - TimeTaken => $time_taken); - } - - elsif ($comment) { - $RT::Logger->debug("Commenting on ticket ".$Ticket->Id); - - my $linesref =GetMessageContent(Edit => $edit, Source => $source, - CurrentUser => $CurrentUser); - #TODO build this entity - require MIME::Entity; - my $MIMEObj = MIME::Entity->build(Data => $linesref); - - $Ticket->Comment( MIMEObj => $MIMEObj, - TimeTaken => $time_taken); - } - - # }}} - - # {{{ Display whatever we need to display - - # {{{ Display a full ticket listing and history - if ($history) { - #Display the history - $RT::Logger->debug("Show history for ".$Ticket->id); - - if ($Ticket->CurrentUserHasRight("ShowTicket")) { - &ShowSummary($Ticket); - print "\n"; - &ShowHistory($Ticket); - } - else { - print "You don't have permission to view that ticket.\n"; - } - } - - # }}} - - # {{{ Display a summary if we need to - if (defined $summary) { - $RT::Logger->debug ("Show ticket summary with format $format"); - - printf $format."\n", eval $code; - - } - # }}} - - # }}} - } - # }}} - + 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"; + } + } + }; -$RT::Handle->Disconnect(); + 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"; -# {{{ sub ParseBooleanOp + local *F; + local $/ = undef; -=head2 ParseBooleanOp + 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); - Takes an option modifier. returns the apropriate SQL operator. - If it's handed ! or -, returns !=. Otherwise returns =. + return $text; +} -=cut +# Add a value to a (possibly multi-valued) hash key. +sub vpush { + my ($hash, $key, $val) = @_; + my @val = ref $val eq 'ARRAY' ? @$val : $val; -sub ParseBooleanOp { - - my $op = shift; - - #so that !new limits to not new, etc - if ($op =~ /^(\!|-)/) { - $op = "!="; + 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 { - $op = "="; + $hash->{$key} = $val; } - - return($op); } -# }}} +# "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); -# {{{ sub ParseLikeOp -=head2 ParseLikeOp + foreach $elt (split /,/, $list) { + if ($elt =~ /^(\d+)-(\d+)$/) { push @elts, ($1..$2) } + else { push @elts, $elt } + } - Takes an option modifier. returns the apropriate SQL operator. - If it's handed ! or -, returns NOT LIKE. Otherwise returns LIKE + @elts{@elts}=(); + return sort {$a<=>$b} keys %elts; +} -=cut +sub get_type_argument { + my $type; -sub ParseLikeOp { - - my $op = shift; - - #so that !new limits to not new, etc - if ($op =~ /^(\!|-)/) { - $op = "NOT LIKE"; + 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 { - $op = "LIKE"; + @_ = ("No type argument specified with -t."); + goto &whine; } - - return($op); + + $type =~ s/s$//; # "Plural". Ugh. + return $type; } -# }}} -# {{{ sub ParseDateToISO +sub get_var_argument { + my ($data) = @_; -=head2 ParseDateToISO + 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; + } +} -Takes a date in an arbitrary format. -Returns an ISO date and time in GMT +sub is_object_spec { + my ($spec, $type) = @_; -=cut + $spec =~ s|^(?:$type/)?|$type/| if defined $type; + return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o); + return; +} -sub ParseDateToISO { - my $date = shift; +__DATA__ - my $date_obj = new RT::Date($CurrentUser); - $date_obj->Set( Format => 'unknown', - Value => $date - ); - return ($date_obj->ISO); -} +Title: intro +Title: introduction +Text: -# }}} + ** THIS IS AN UNSUPPORTED PREVIEW RELEASE ** + ** PLEASE REPORT BUGS TO rt-bugs@fsck.com ** -# {{{ sub ParseDateRange + This is a command-line interface to RT 3. -=head2 ParseDateRange [RANGE] + 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. -Takes a range of dates of the form [<date>][-][<date>] and returns -starting and ending dates (as ISOs) If a date is specified as neither a starting nor ending -date, we parse it it as "midnight tonight to midnight tomorrow" + 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. -=cut + For more information: -sub ParseDateRange { - my $in = shift; - my ($start, $end); - - - use RT::Date; - my $start_obj = new RT::Date($CurrentUser); - my $end_obj = new RT::Date($CurrentUser); - - if ($in =~ /^(.*?)-(.*?)$/) { - $start = $1; - $end = $2; - - if ($start) { - $start_obj->Set(Format => 'unknown', - Value => $start); - } - if ($end) { - $end_obj->Set(Format => 'unknown', - Value => $end); - } - } - else { - $start = $in; - $end = $in; - - $start_obj->Set(Format => 'unknown', - Value => $start); - - $end_obj->Set(Format => 'unknown', - Value => $end); - - $start_obj->SetToMidnight(); - $end_obj->SetToMidnight(); - $end_obj->AddDay(); - } - - if ($start) { - $start = $start_obj->ISO; - } - if ($end) { - $end = $end_obj->ISO; - } + - rt help actions (a list of possible actions) + - rt help objects (how to specify objects) + - rt help usage (syntax information) - return ($start, $end); -} + - rt help config (configuration details) + - rt help examples (a few useful examples) + - rt help topics (a list of help topics) -# }}} +-- -# {{{ ParseRange -=head2 ParseRange [RANGE] +Title: usage +Title: syntax +Text: -Takes a range of the form [<int>][-][<int>] and returns -a first and a last value. If the - is omitted, both $start and $end are the same. -=cut + Syntax: -sub ParseRange { - my $in = shift; - my ($start, $end); - - if ($in =~ /(.*?)-(.*?)/) { - $start = $1; - $end = $2; - } - else { - $start = $in; - $end = $in; - } - - return ($start, $end); - + 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.) -# }}} - -# {{{ sub ShowSummary - -sub ShowSummary { - my $Ticket = shift; - - - print <<EOFORM; -Serial Number: @{[$Ticket->Id]} Status:@{[$Ticket->Status]} Worked: @{[$Ticket->TimeWorked]} minutes Queue:@{[$Ticket->QueueObj->Name]} - Subject: @{[$Ticket->Subject]} - Requestors: @{[$Ticket->RequestorsAsString]} - Cc: @{[$Ticket->CcAsString]} - Admin Cc: @{[$Ticket->AdminCcAsString]} - Owner: @{[$Ticket->OwnerObj->Name]} - Priority: @{[$Ticket->Priority]} / @{[$Ticket->FinalPriority]} - Due: @{[$Ticket->DueAsString]} - Created: @{[$Ticket->CreatedAsString]} (@{[$Ticket->AgeAsString]}) - Last Contact: @{[$Ticket->ToldAsString]} (@{[$Ticket->LongSinceToldAsString]}) - Last Update: @{[$Ticket->LastUpdatedAsString]} by @{[$Ticket->LastUpdatedByObj->Name]} - -EOFORM - -my $selects = $Ticket->QueueObj->KeywordSelects(); - #get the keyword selects - print "Keywords:\n"; - while (my $select = $selects->Next) { - print "\t" .$select->Name .": "; - my $keys = $Ticket->KeywordsObj($select->id); - while (my $key = $keys->Next) { - print $key->KeywordObj->RelativePath($select->KeywordObj) . " "; - - } - print "\n"; - } + 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". -#iterate through the keyword selects. -#print the keyword select and all the related keywords + 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 -#TODO: finish link descriptions -print "Dependencies: \n"; - while (my $l=$Ticket->DependedOnBy->Next) { - print $l->BaseObj->id," (",$l->BaseObj->Subject,") ",$l->Type," this ticket\n"; - } - while (my $l=$Ticket->DependsOn->Next) { - print "This ticket ",$l->Type," ",$l->TargetObj->Id," (",$l->TargetObj->Subject,")\n"; - } -} + For more information: -# }}} - -# {{{ sub ShowHistory -sub ShowHistory { - my $Ticket = shift; - my $Transaction; - my $Transactions = $Ticket->Transactions; - - while ($Transaction = $Transactions->Next) { - &ShowTransaction($Transaction); - } - } -# }}} - -# {{{ sub ShowTransaction -sub ShowTransaction { - my $transaction = shift; - -print <<EOFORM; -========================================================================== -Date: @{[$transaction->CreatedAsString]} (@{[$transaction->TimeTaken]} minutes) -@{[$transaction->Description]} -EOFORM - ; - my $attachments=$transaction->Attachments(); - while (my $message=$attachments->Next) { - print <<EOFORM; --------------------------------------------------------------------------- -@{[$message->Headers]} -EOFORM - - if ($message->ContentType =~ m{^(text/plain|message|text$)}) { - print $message->Content; - } else { - print $message->ContentType, " not shown"; - } - } - print "\n"; - return(); -} -# }}} - - -# {{{ sub BuildListingFormat - -sub BuildListingFormat { - my $format_string = shift; - - my ($id, @format, @code, @titles); - my ($field,$titles,$length, $format); - - my $code = ""; - - # {{{ attribs - my $attribs = { id => { chars => '4', - justify => 'r', - title => 'id', - value => '$Ticket->id', - }, - - queue => { chars => '8', - justify => 'l', - title => 'Queue', - value => '$Ticket->QueueObj->Name' - }, - subject => { chars => '30', - justify => 'l', - title => 'Subject', - value => '$Ticket->Subject', - }, - priority => { chars => '2', - justify => 'r', - title => 'Pri', - value => '$Ticket->Priority', - }, - final_priority => { chars => '2', - justify => 'r', - title => 'Fin', - value => '$Ticket->FinalPriority', - }, - time_worked => { chars => '6', - justify => 'r', - title => 'Worked', - value => '$Ticket->TimeWorked', - }, - time_left => { chars => '5', - justify => 'r', - title => 'Left', - value => '$Ticket->TimeLeft', - - }, - - status => { chars => '6', - justify => 'r', - title => 'Status', - value => '$Ticket->Status', - }, - owner => { chars => '10', - justify => 'r', - title => 'Owner', - value => '$Ticket->OwnerObj->Name' - }, - requestor => { chars => '10', - justify => 'r', - title => 'Requestor', - value => '$Ticket->RequestorsAsString' - }, - created => { chars => '12', - justify => 'r', - title => 'Created', - value => '$Ticket->CreatedAsString' - }, - updated => { chars => '12', - justify => 'r', - title => 'Updated', - value => '$Ticket->LastUpdatedAsString' - }, - due => { chars => '12', - justify => 'r', - title => 'Due', - value => '$Ticket->DueAsString' - }, - told => { chars => '12', - justify => 'r', - title => 'Told', - value => '$Ticket->ToldAsString' - }, - - - - }; - - # }}} + - 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?) - foreach $field (split ('%',$format_string)) { - - if ($field =~ /^(\D*?)(\d*?)$/) { - $id = $1; - $length = $2; - } - else { - $RT::Logger->debug ("Error parsing $field\n"); - } - if ($length) { - push (@format, "%".$length.".".$length."s "); - - push (@code, $attribs->{"$id"}->{'value'}); - - push (@titles, "'". $attribs->{"$id"}->{title}. "'"); - } - - - } - $code = join (',', @code); - $format = join (" ", @format); - $titles = join (', ', @titles); +-- + +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. - - return ($format, $titles, $code); -} + 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. -1; +-- diff --git a/rt/bin/rt-crontool b/rt/bin/rt-crontool index ede874a..cdbc3cb 100644 --- a/rt/bin/rt-crontool +++ b/rt/bin/rt-crontool @@ -197,7 +197,7 @@ sub help { ) . "\n\n"; - print " sbin/cron_shim \\\n"; + print " bin/rt-cron-tool \\\n"; print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; print @@ -205,6 +205,16 @@ sub help { print " --action RT::Action::SetPriority --action-arg 99 \\\n"; print " --verbose\n"; + print "\n"; + print loc("Escalate tickets"); + print "rt-crontool \\\n"; + print " --search RT::Search::ActiveTicketsInQueue --search-arg thequeuename \\\n"; + print " --action RT::Action::EscalatePriority \\\n"; + + + + + exit(0); } diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in index 73b80aa..8ecc718 100644 --- a/rt/bin/rt-crontool.in +++ b/rt/bin/rt-crontool.in @@ -197,7 +197,7 @@ sub help { ) . "\n\n"; - print " sbin/cron_shim \\\n"; + print " bin/rt-cron-tool \\\n"; print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; print @@ -205,6 +205,16 @@ sub help { print " --action RT::Action::SetPriority --action-arg 99 \\\n"; print " --verbose\n"; + print "\n"; + print loc("Escalate tickets"); + print "rt-crontool \\\n"; + print " --search RT::Search::ActiveTicketsInQueue --search-arg thequeuename \\\n"; + print " --action RT::Action::EscalatePriority \\\n"; + + + + + exit(0); } diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate index b304436..8af8002 100755 --- a/rt/bin/rt-mailgate +++ b/rt/bin/rt-mailgate @@ -1,26 +1,26 @@ #!/usr/bin/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 =head1 NAME @@ -31,10 +31,25 @@ rt-mailgate - Mail interface to RT3. use RT::I18N; +# Make sure that when we call the mailgate wrong, it tempfails + +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://bad.address"), "Opened the mailgate - The error below is expected - $@"); +print MAIL <<EOF; +From: root\@localhost +To: rt\@example.com +Subject: This is a test of new ticket creation + +Foob! +EOF +close (MAIL); + +# Check the return value +is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay"); + # {{{ Test new ticket creation by root who is privileged and superuser -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: root\@localhost To: rt\@example.com @@ -45,6 +60,9 @@ Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + use RT::Tickets; my $tickets = RT::Tickets->new($RT::SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); @@ -59,7 +77,7 @@ ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the tick # {{{This is a test of new ticket creation as an unknown user -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist\@example.com To: rt\@example.com @@ -69,6 +87,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $tickets = RT::Tickets->new($RT::SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); @@ -94,7 +114,7 @@ ok ($val, "Granted everybody the right to create tickets - $msg"); sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist\@example.com To: rt\@example.com @@ -104,6 +124,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $tickets = RT::Tickets->new($RT::SystemUser); @@ -126,7 +148,7 @@ ok( $u->Id != 0, " user does not exist and was created by ticket submission"); #ok ($val, "Granted everybody the right to create tickets - $msg"); #sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-2\@example.com To: rt\@example.com @@ -136,6 +158,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $u = RT::User->new($RT::SystemUser); $u->Load('doesnotexist-2@example.com'); @@ -148,7 +172,7 @@ ok( $u->Id == 0, " user does not exist and was not created by ticket corresponde ok ($val, "Granted everybody the right to reply to tickets - $msg"); sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-2\@example.com To: rt\@example.com @@ -158,6 +182,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $u = RT::User->new($RT::SystemUser); @@ -173,7 +199,7 @@ ok( $u->Id != 0, " user exists and was created by ticket correspondence submissi #ok ($val, "Granted everybody the right to create tickets - $msg"); #sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-3\@example.com To: rt\@example.com @@ -184,6 +210,9 @@ Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + $u = RT::User->new($RT::SystemUser); $u->Load('doesnotexist-3@example.com'); ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission"); @@ -196,7 +225,7 @@ ok( $u->Id == 0, " user does not exist and was not created by ticket comment sub ok ($val, "Granted everybody the right to reply to tickets - $msg"); sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-3\@example.com To: rt\@example.com @@ -207,6 +236,8 @@ Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $u = RT::User->new($RT::SystemUser); $u->Load('doesnotexist-3@example.com'); @@ -227,17 +258,20 @@ my $entity = MIME::Entity->build( From => 'root@localhost', Data => ['This is a test of a binary attachment']); # currently in lib/t/autogen -$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif', +$entity->attach(Path => '/opt/rt3/share/html/NoAuth/images/spacer.gif', Type => 'image/gif', Encoding => 'base64'); # Create a ticket with a binary attachment -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); $entity->print(\*MAIL); close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + my $tickets = RT::Tickets->new($RT::SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); @@ -273,7 +307,7 @@ use LWP::UserAgent; # Grab the binary attachment via the web ui my $ua = LWP::UserAgent->new(); -my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password"; +my $full_url = "http://localhost".$RT::WebPath."/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password"; my $r = $ua->get( $full_url); @@ -286,7 +320,7 @@ is($file, $r->content, 'The attachment isn\'t screwed up in download'); # {{{ Simple I18N testing -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: root\@localhost @@ -301,6 +335,9 @@ bye EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + my $unitickets = RT::Tickets->new($RT::SystemUser); $unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); @@ -317,7 +354,7 @@ is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attac ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id); # supposedly I18N fails on the second message sent in. -ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: root\@localhost @@ -332,6 +369,9 @@ bye EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + my $tickets2 = RT::Tickets->new($RT::SystemUser); $tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); @@ -367,7 +407,7 @@ use LWP::UserAgent; use constant EX_TEMPFAIL => 75; my %opts; -GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" ); +GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" ); if ( $opts{help} ) { require Pod::Usage; @@ -381,17 +421,18 @@ for (qw(url)) { } undef $/; -my $message = <>; my $ua = LWP::UserAgent->new(); $ua->cookie_jar( { file => $opts{jar} } ); my %args = ( queue => $opts{queue}, action => $opts{action}, - message => $message, SessionType => 'REST', # Surpress login box ); +# Read the message in from STDIN +$args{'message'} = <>; + if ($opts{'extension'}) { $args{$opts{'extension'}} = $ENV{'EXTENSION'}; @@ -404,6 +445,7 @@ warn "Connecting to $full_url" if $opts{'debug'}; +$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180); my $r = $ua->post( $full_url, {%args} ); check_failure($r); @@ -414,7 +456,7 @@ if ( $content !~ /^(ok|not ok)/ ) { # It's not the server's fault if the mail is bogus. We just want to know that # *something* came out of the server. - die <<EOF + warn <<EOF; RT server error. The RT server which handled your email did not behave as expected. It @@ -423,8 +465,13 @@ said: $content EOF +exit EX_TEMPFAIL; + } +exit; + + sub check_failure { my $r = shift; return if $r->is_success(); @@ -455,7 +502,11 @@ Usual invocation (from MTA): rt-mailgate --action (correspond|comment) --queue queuename --url http://your.rt.server/ - [ --extension (queue|action|ticket) + [ --debug ] + [ --extension (queue|action|ticket) ] + [ --timeout seconds ] + + See C<man rt-mailgate> for more. @@ -486,6 +537,16 @@ submitted to will be set to the value of $EXTENSION. By specifying is related to. "action" will allow the user to specify either "comment" or "correspond" in the address extension. +=item C<--debug> OPTIONAL + +Print debugging output to standard error + + +=item C<--timeout> OPTIONAL + +Configure the timeout for posting the message to the web server. The +default timeout is 3 minutes (180 seconds). + =head1 DESCRIPTION diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in index 304fcbc..2ddb604 100644 --- a/rt/bin/rt-mailgate.in +++ b/rt/bin/rt-mailgate.in @@ -1,26 +1,26 @@ #!@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 =head1 NAME @@ -31,10 +31,25 @@ rt-mailgate - Mail interface to RT3. use RT::I18N; +# Make sure that when we call the mailgate wrong, it tempfails + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://bad.address"), "Opened the mailgate - The error below is expected - $@"); +print MAIL <<EOF; +From: root\@localhost +To: rt\@example.com +Subject: This is a test of new ticket creation + +Foob! +EOF +close (MAIL); + +# Check the return value +is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay"); + # {{{ Test new ticket creation by root who is privileged and superuser -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: root\@localhost To: rt\@example.com @@ -45,6 +60,9 @@ Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + use RT::Tickets; my $tickets = RT::Tickets->new($RT::SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); @@ -59,7 +77,7 @@ ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the tick # {{{This is a test of new ticket creation as an unknown user -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist\@example.com To: rt\@example.com @@ -69,6 +87,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $tickets = RT::Tickets->new($RT::SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); @@ -94,7 +114,7 @@ ok ($val, "Granted everybody the right to create tickets - $msg"); sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist\@example.com To: rt\@example.com @@ -104,6 +124,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $tickets = RT::Tickets->new($RT::SystemUser); @@ -126,7 +148,7 @@ ok( $u->Id != 0, " user does not exist and was created by ticket submission"); #ok ($val, "Granted everybody the right to create tickets - $msg"); #sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-2\@example.com To: rt\@example.com @@ -136,6 +158,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $u = RT::User->new($RT::SystemUser); $u->Load('doesnotexist-2@example.com'); @@ -148,7 +172,7 @@ ok( $u->Id == 0, " user does not exist and was not created by ticket corresponde ok ($val, "Granted everybody the right to reply to tickets - $msg"); sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-2\@example.com To: rt\@example.com @@ -158,6 +182,8 @@ Blah! Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $u = RT::User->new($RT::SystemUser); @@ -173,7 +199,7 @@ ok( $u->Id != 0, " user exists and was created by ticket correspondence submissi #ok ($val, "Granted everybody the right to create tickets - $msg"); #sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-3\@example.com To: rt\@example.com @@ -184,6 +210,9 @@ Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + $u = RT::User->new($RT::SystemUser); $u->Load('doesnotexist-3@example.com'); ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission"); @@ -196,7 +225,7 @@ ok( $u->Id == 0, " user does not exist and was not created by ticket comment sub ok ($val, "Granted everybody the right to reply to tickets - $msg"); sleep(60); # gotta sleep so the remote process' ACL cache times out -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@"); print MAIL <<EOF; From: doesnotexist-3\@example.com To: rt\@example.com @@ -207,6 +236,8 @@ Foob! EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); $u = RT::User->new($RT::SystemUser); $u->Load('doesnotexist-3@example.com'); @@ -227,17 +258,20 @@ my $entity = MIME::Entity->build( From => 'root@localhost', Data => ['This is a test of a binary attachment']); # currently in lib/t/autogen -$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif', +$entity->attach(Path => '@MASON_HTML_PATH@/NoAuth/images/spacer.gif', Type => 'image/gif', Encoding => 'base64'); # Create a ticket with a binary attachment -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); $entity->print(\*MAIL); close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + my $tickets = RT::Tickets->new($RT::SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); @@ -273,7 +307,7 @@ use LWP::UserAgent; # Grab the binary attachment via the web ui my $ua = LWP::UserAgent->new(); -my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password"; +my $full_url = "http://localhost".$RT::WebPath."/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password"; my $r = $ua->get( $full_url); @@ -286,7 +320,7 @@ is($file, $r->content, 'The attachment isn\'t screwed up in download'); # {{{ Simple I18N testing -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: root\@localhost @@ -301,6 +335,9 @@ bye EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + my $unitickets = RT::Tickets->new($RT::SystemUser); $unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); @@ -317,7 +354,7 @@ is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attac ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id); # supposedly I18N fails on the second message sent in. -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); print MAIL <<EOF; From: root\@localhost @@ -332,6 +369,9 @@ bye EOF close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + my $tickets2 = RT::Tickets->new($RT::SystemUser); $tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); @@ -367,7 +407,7 @@ use LWP::UserAgent; use constant EX_TEMPFAIL => 75; my %opts; -GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" ); +GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" ); if ( $opts{help} ) { require Pod::Usage; @@ -381,17 +421,18 @@ for (qw(url)) { } undef $/; -my $message = <>; my $ua = LWP::UserAgent->new(); $ua->cookie_jar( { file => $opts{jar} } ); my %args = ( queue => $opts{queue}, action => $opts{action}, - message => $message, SessionType => 'REST', # Surpress login box ); +# Read the message in from STDIN +$args{'message'} = <>; + if ($opts{'extension'}) { $args{$opts{'extension'}} = $ENV{'EXTENSION'}; @@ -404,6 +445,7 @@ warn "Connecting to $full_url" if $opts{'debug'}; +$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180); my $r = $ua->post( $full_url, {%args} ); check_failure($r); @@ -414,7 +456,7 @@ if ( $content !~ /^(ok|not ok)/ ) { # It's not the server's fault if the mail is bogus. We just want to know that # *something* came out of the server. - die <<EOF + warn <<EOF; RT server error. The RT server which handled your email did not behave as expected. It @@ -423,8 +465,13 @@ said: $content EOF +exit EX_TEMPFAIL; + } +exit; + + sub check_failure { my $r = shift; return if $r->is_success(); @@ -455,7 +502,11 @@ Usual invocation (from MTA): rt-mailgate --action (correspond|comment) --queue queuename --url http://your.rt.server/ - [ --extension (queue|action|ticket) + [ --debug ] + [ --extension (queue|action|ticket) ] + [ --timeout seconds ] + + See C<man rt-mailgate> for more. @@ -486,6 +537,16 @@ submitted to will be set to the value of $EXTENSION. By specifying is related to. "action" will allow the user to specify either "comment" or "correspond" in the address extension. +=item C<--debug> OPTIONAL + +Print debugging output to standard error + + +=item C<--timeout> OPTIONAL + +Configure the timeout for posting the message to the web server. The +default timeout is 3 minutes (180 seconds). + =head1 DESCRIPTION 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. + +-- diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl index 21cb83f..96e7ebf 100755 --- a/rt/bin/webmux.pl +++ b/rt/bin/webmux.pl @@ -31,6 +31,7 @@ BEGIN { $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; $ENV{'ENV'} = '' if defined $ENV{'ENV'}; $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + } use lib ("/opt/rt3/local/lib", "/opt/rt3/lib"); @@ -42,6 +43,17 @@ use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we #set private_tempfiles BEGIN { + if ($mod_perl::VERSION >= 1.9908) { + require Apache::RequestUtil; + no warnings 'redefine'; + my $sub = *Apache::request{CODE}; + *Apache::request = sub { + my $r; + eval { $r = $sub->('Apache'); }; + # warn $@ if $@; + return $r; + }; + } if ($CGI::MOD_PERL) { require HTML::Mason::ApacheHandler; } @@ -104,21 +116,32 @@ if ( $CGI::MOD_PERL) { unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) ); } -my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL; +my $ah = &RT::Interface::Web::NewApacheHandler(@RT::MasonParameters) if $CGI::MOD_PERL; sub handler { ($r) = @_; + local $SIG{__WARN__}; + local $SIG{__DIE__}; + RT::Init(); # We don't need to handle non-text items return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io; my %session; - my $status = $ah->handle_request($r); + my $status; + eval { $status = $ah->handle_request($r) }; + if ($@) { + $RT::Logger->crit($@); + } + undef (%session); - $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth; + if ($RT::Handle->TransactionDepth) { + $RT::Handle->ForceRollback; + $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ; + } return $status; } diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in index 12aad85..dca5705 100644 --- a/rt/bin/webmux.pl.in +++ b/rt/bin/webmux.pl.in @@ -31,6 +31,7 @@ BEGIN { $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; $ENV{'ENV'} = '' if defined $ENV{'ENV'}; $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + @ORACLE_ENV_PREF@ } use lib ("@LOCAL_LIB_PATH@", "@RT_LIB_PATH@"); @@ -42,6 +43,17 @@ use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we #set private_tempfiles BEGIN { + if ($mod_perl::VERSION >= 1.9908) { + require Apache::RequestUtil; + no warnings 'redefine'; + my $sub = *Apache::request{CODE}; + *Apache::request = sub { + my $r; + eval { $r = $sub->('Apache'); }; + # warn $@ if $@; + return $r; + }; + } if ($CGI::MOD_PERL) { require HTML::Mason::ApacheHandler; } @@ -104,21 +116,32 @@ if ( $CGI::MOD_PERL) { unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) ); } -my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL; +my $ah = &RT::Interface::Web::NewApacheHandler(@RT::MasonParameters) if $CGI::MOD_PERL; sub handler { ($r) = @_; + local $SIG{__WARN__}; + local $SIG{__DIE__}; + RT::Init(); # We don't need to handle non-text items return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io; my %session; - my $status = $ah->handle_request($r); + my $status; + eval { $status = $ah->handle_request($r) }; + if ($@) { + $RT::Logger->crit($@); + } + undef (%session); - $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth; + if ($RT::Handle->TransactionDepth) { + $RT::Handle->ForceRollback; + $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ; + } return $status; } |