summaryrefslogtreecommitdiff
path: root/rt/bin
diff options
context:
space:
mode:
Diffstat (limited to 'rt/bin')
-rwxr-xr-xrt/bin/mason_handler.fcgi13
-rw-r--r--rt/bin/mason_handler.fcgi.in13
-rwxr-xr-xrt/bin/mason_handler.scgi12
-rw-r--r--rt/bin/mason_handler.scgi.in12
-rw-r--r--rt/bin/mason_handler.svc13
-rw-r--r--rt/bin/mason_handler.svc.in13
-rwxr-xr-xrt/bin/rt665
-rw-r--r--rt/bin/rt-crontool211
-rw-r--r--rt/bin/rt-crontool.in211
-rwxr-xr-xrt/bin/rt-mailgate164
-rw-r--r--rt/bin/rt-mailgate.in164
-rw-r--r--rt/bin/rt.in665
-rwxr-xr-xrt/bin/standalone_httpd141
-rwxr-xr-xrt/bin/standalone_httpd.in141
-rwxr-xr-xrt/bin/webmux.pl57
-rw-r--r--rt/bin/webmux.pl.in57
16 files changed, 2168 insertions, 384 deletions
diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi
index 9bef9a89f..4fe888a93 100755
--- a/rt/bin/mason_handler.fcgi
+++ b/rt/bin/mason_handler.fcgi
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -51,12 +51,17 @@ package RT::Mason;
use strict;
use vars '$Handler';
use File::Basename;
-require ('/opt/rt3/bin/webmux.pl');
+
+require (dirname(__FILE__) . '/webmux.pl');
# Enter CGI::Fast mode, which should also work as a vanilla CGI script.
require CGI::Fast;
RT::Init();
+$Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+);
+
while ( my $cgi = CGI::Fast->new ) {
# the whole point of fastcgi requires the env to get reset here..
@@ -67,7 +72,7 @@ while ( my $cgi = CGI::Fast->new ) {
$ENV{'ENV'} = '' if defined $ENV{'ENV'};
$ENV{'IFS'} = '' if defined $ENV{'IFS'};
- Module::Refresh->refresh if $RT::DevelMode;
+ Module::Refresh->refresh if RT->Config->Get('DevelMode');
RT::ConnectToDatabase();
if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in
index 26842d31e..48155f257 100644
--- a/rt/bin/mason_handler.fcgi.in
+++ b/rt/bin/mason_handler.fcgi.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -51,12 +51,17 @@ package RT::Mason;
use strict;
use vars '$Handler';
use File::Basename;
-require ('@RT_BIN_PATH@/webmux.pl');
+
+require (dirname(__FILE__) . '/webmux.pl');
# Enter CGI::Fast mode, which should also work as a vanilla CGI script.
require CGI::Fast;
RT::Init();
+$Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+);
+
while ( my $cgi = CGI::Fast->new ) {
# the whole point of fastcgi requires the env to get reset here..
@@ -67,7 +72,7 @@ while ( my $cgi = CGI::Fast->new ) {
$ENV{'ENV'} = '' if defined $ENV{'ENV'};
$ENV{'IFS'} = '' if defined $ENV{'IFS'};
- Module::Refresh->refresh if $RT::DevelMode;
+ Module::Refresh->refresh if RT->Config->Get('DevelMode');
RT::ConnectToDatabase();
if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi
index 6a3404ea5..248c57ca2 100755
--- a/rt/bin/mason_handler.scgi
+++ b/rt/bin/mason_handler.scgi
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -50,11 +50,17 @@ package RT::Mason;
use strict;
use vars '$Handler';
-require ('/opt/rt3/bin/webmux.pl');
+use File::Basename;
+
+require (dirname(__FILE__) . '/webmux.pl');
require CGI;
RT::Init();
+$Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+);
+
my $cgi = CGI->new;
if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in
index 2d77e8f82..a853529d0 100644
--- a/rt/bin/mason_handler.scgi.in
+++ b/rt/bin/mason_handler.scgi.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -50,11 +50,17 @@ package RT::Mason;
use strict;
use vars '$Handler';
-require ('@RT_BIN_PATH@/webmux.pl');
+use File::Basename;
+
+require (dirname(__FILE__) . '/webmux.pl');
require CGI;
RT::Init();
+$Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+);
+
my $cgi = CGI->new;
if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
diff --git a/rt/bin/mason_handler.svc b/rt/bin/mason_handler.svc
index 86adfae28..3cde20cd1 100644
--- a/rt/bin/mason_handler.svc
+++ b/rt/bin/mason_handler.svc
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -111,7 +111,7 @@ BEGIN {
$Win32::TieRegistry::Registry->{
'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\\'.
'W3SVC\Parameters\Virtual Roots\\'
- }->{$RT::WebPath || '/'} = "$path,,205";
+ }->{RT->Config->Get('WebPath') || '/'} = "$path,,205";
$Win32::TieRegistry::Registry->{
'HKEY_LOCAL_MACHINE\Software\FASTCGI\.html\\'
@@ -225,13 +225,18 @@ warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
require CGI::Fast;
RT::Init();
+$Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+);
+
# Response loop
while( my $cgi = CGI::Fast->new ) {
my $comp = $ENV{'PATH_INFO'};
$comp = $1 if ($comp =~ /^(.*)$/);
- $comp =~ s|^$RT::WebPath\b||i;
+ my $web_path = RT->Config->Get('WebPath');
+ $comp =~ s|^\Q$web_path\E\b||i;
$comp .= "index.html" if ($comp =~ /\/$/);
$comp =~ s/.pl$/.html/g;
diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in
index 3bf851c7a..d7e68b3a2 100644
--- a/rt/bin/mason_handler.svc.in
+++ b/rt/bin/mason_handler.svc.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -111,7 +111,7 @@ BEGIN {
$Win32::TieRegistry::Registry->{
'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\\'.
'W3SVC\Parameters\Virtual Roots\\'
- }->{$RT::WebPath || '/'} = "$path,,205";
+ }->{RT->Config->Get('WebPath') || '/'} = "$path,,205";
$Win32::TieRegistry::Registry->{
'HKEY_LOCAL_MACHINE\Software\FASTCGI\.html\\'
@@ -225,13 +225,18 @@ warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
require CGI::Fast;
RT::Init();
+$Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+);
+
# Response loop
while( my $cgi = CGI::Fast->new ) {
my $comp = $ENV{'PATH_INFO'};
$comp = $1 if ($comp =~ /^(.*)$/);
- $comp =~ s|^$RT::WebPath\b||i;
+ my $web_path = RT->Config->Get('WebPath');
+ $comp =~ s|^\Q$web_path\E\b||i;
$comp .= "index.html" if ($comp =~ /\/$/);
$comp =~ s/.pl$/.html/g;
diff --git a/rt/bin/rt b/rt/bin/rt
index 3440d9e57..9554a932c 100755
--- a/rt/bin/rt
+++ b/rt/bin/rt
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -58,7 +58,19 @@ use Cwd;
use LWP;
use Text::ParseWords;
use HTTP::Request::Common;
+use HTTP::Headers;
use Term::ReadLine;
+use Time::Local; # used in prettyshow
+
+# strong (GSSAPI based) authentication is supported if the server does provide
+# it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed
+# it can be suppressed by setting externalauth=0 (default is undef)
+eval { require GSSAPI };
+my $no_strong_auth = 'missing perl module GSSAPI';
+if ( ! $@ ) {
+ eval {require LWP::Authen::Negotiate};
+ $no_strong_auth = $@ ? 'missing perl module LWP::Authen::Negotiate' : 0;
+}
# We derive configuration information from hardwired defaults, dotfiles,
# and the RT* environment variables (in increasing order of precedence).
@@ -70,18 +82,27 @@ my $HOME = eval{(getpwuid($<))[7]}
|| ".";
my %config = (
(
- debug => 0,
- user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
- passwd => undef,
- server => 'http://localhost/',
- query => undef,
- orderby => undef,
+ debug => 0,
+ user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
+ passwd => undef,
+ server => 'http://localhost/',
+ query => "Status!='resolved' and Status!='rejected'",
+ orderby => 'id',
+ queue => undef,
+# to protect against unlimited searches a better choice would be
+# queue => 'Unknown_Queue',
+# setting externalauth => undef will try GSSAPI auth if the corresponding perl
+# modules are installed, externalauth => 0 is the backward compatible choice
+ externalauth => 0,
),
config_from_file($ENV{RTCONFIG} || ".rtrc"),
config_from_env()
);
my $session = new Session("$HOME/.rt_sessions");
my $REST = "$config{server}/REST/1.0";
+$no_strong_auth = 'switched off by externalauth=0'
+ if defined $config{externalauth};
+
my $prompt = 'rt> ';
@@ -91,11 +112,12 @@ 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_-]|\s+)*)';
-my $label = '[a-zA-Z0-9@_.+-]+';
-my $labels = "(?:$label,)*$label";
-my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
+my $name = '[\w.-]+';
+my $CF_name = '[\sa-z0-9_ :()/-]+';
+my $field = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
+my $label = '[a-zA-Z0-9@_.+-]+';
+my $labels = "(?:$label,)*$label";
+my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
# Our command line looks like this:
#
@@ -119,6 +141,8 @@ my %handlers = (
grant => ["grant", "revoke"],
take => ["take", "steal", "untake"],
quit => ["quit", "exit"],
+ setcommand => ["del", "delete", "give", "res", "resolve",
+ "subject"],
);
my %actions;
@@ -137,16 +161,16 @@ sub handler {
shift @ARGV if ($ARGV[0] eq 'rt'); # ignore a leading 'rt'
if (@ARGV && exists $actions{$ARGV[0]}) {
$action = shift @ARGV;
- $actions{$action}->($action);
+ return $actions{$action}->($action);
}
else {
print STDERR "rt: Unknown command '@ARGV'.\n";
print STDERR "rt: For help, run 'rt help'.\n";
+ return 1;
}
}
-handler();
-exit;
+exit handler();
# Handler functions.
# ------------------
@@ -166,10 +190,12 @@ sub shell {
sub version {
print "rt $VERSION\n";
+ return 0;
}
sub logout {
submit("$REST/logout") if defined $session->cookie;
+ return 0;
}
sub quit {
@@ -179,7 +205,8 @@ sub quit {
my %help;
sub help {
- my ($action, $type) = @_;
+ my ($action, $type, $rv) = @_;
+ $rv = defined $rv ? $rv : 0;
my $key;
# What help topics do we know about?
@@ -228,6 +255,7 @@ sub help {
}
print STDERR $help{$key}, "\n\n";
+ return $rv;
}
# Displays a list of objects that match some specified condition.
@@ -240,6 +268,9 @@ sub list {
$data{orderby} = $config{orderby};
}
my $bad = 0;
+ my $rawprint = 0;
+ my $reverse_sort = 0;
+ my $queue = $config{queue};
while (@ARGV) {
$_ = shift @ARGV;
@@ -255,6 +286,13 @@ sub list {
}
elsif (/^-([isl])$/) {
$data{format} = $1;
+ $rawprint = 1;
+ }
+ elsif (/^-q$/) {
+ $queue = shift @ARGV;
+ }
+ elsif (/^-r$/) {
+ $reverse_sort = 1;
}
elsif (/^-f$/) {
if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
@@ -262,6 +300,8 @@ sub list {
$bad = 1; last;
}
$data{fields} = shift @ARGV;
+ $data{format} = 's' if ! $data{format};
+ $rawprint = 1;
}
elsif (!defined $q && !/^-/) {
$q = $_;
@@ -272,10 +312,35 @@ sub list {
$bad = 1; last;
}
}
+ if ( ! $rawprint and ! exists $data{format} ) {
+ $data{format} = 'l';
+ }
+ if ( $reverse_sort and $data{orderby} =~ /^-/ ) {
+ $data{orderby} =~ s/^-/+/;
+ } elsif ($reverse_sort) {
+ $data{orderby} =~ s/^\+?(.*)/-$1/;
+ }
+
if (!defined $q) {
$q = $config{query};
}
+ $q =~ s/^#//; # get rid of leading hash
+ if ($q =~ /^\d+$/) {
+ # only digits, must be an id, formulate a correct query
+ $q = "id=$q" if $q =~ /^\d+$/;
+ } else {
+ # a string only, take it as an owner or requestor (quoting done later)
+ $q = "(Owner=$q or Requestor like $q) and $config{query}"
+ if $q =~ /^[\w\-]+$/;
+ # always add a query for a specific queue or (comma separated) queues
+ $queue =~ s/,/ or Queue=/g if $queue;
+ $q .= " and (Queue=$queue)" if $queue and $q and $q !~ /Queue\s*=/i
+ and $q !~ /id\s*=/i;
+ }
+ # correctly quote strings in a query
+ $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g;
+
$type ||= "ticket";
unless ($type && defined $q) {
my $item = $type ? "query string" : "object type";
@@ -283,10 +348,17 @@ sub list {
$bad = 1;
}
#return help("list", $type) if $bad;
- return suggest_help("list", $type) if $bad;
+ return suggest_help("list", $type, $bad) if $bad;
+ print "Query:$q\n" if ! $rawprint;
my $r = submit("$REST/search/$type", { query => $q, %data });
- print $r->content;
+ if ( $rawprint ) {
+ print $r->content;
+ } else {
+ my $forms = Form::parse($r->content);
+ prettylist ($forms);
+ }
+ return 0;
}
# Displays selected information about a single object.
@@ -295,10 +367,12 @@ sub show {
my ($type, @objects, %data);
my $slurped = 0;
my $bad = 0;
+ my $rawprint = 0;
+ my $histspec;
while (@ARGV) {
$_ = shift @ARGV;
-
+ s/^#// if /^#\d+/; # get rid of leading hash
if (/^-t$/) {
$bad = 1, last unless defined($type = get_type_argument());
}
@@ -307,6 +381,7 @@ sub show {
}
elsif (/^-([isl])$/) {
$data{format} = $1;
+ $rawprint = 1;
}
elsif (/^-$/ && !$slurped) {
chomp(my @lines = <STDIN>);
@@ -325,9 +400,21 @@ sub show {
$bad = 1; last;
}
$data{fields} = shift @ARGV;
+ # option f requires short raw listing format
+ $data{format} = 's';
+ $rawprint = 1;
+ }
+ elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
+ push @objects, $spc2;
+ $histspec = is_object_spec("ticket/$_/history", $type);
+ }
+ elsif (/^\d+\// and my $spc3 = is_object_spec("ticket/$_", $type)) {
+ push @objects, $spc3;
+ $rawprint = 1 if $_ =~ /\/content$/;
}
elsif (my $spec = is_object_spec($_, $type)) {
push @objects, $spec;
+ $rawprint = 1 if $_ =~ /\/content$/ or $_ !~ /^ticket/;
}
else {
my $datum = /^-/ ? "option" : "argument";
@@ -335,13 +422,17 @@ sub show {
$bad = 1; last;
}
}
+ if ( ! $rawprint ) {
+ push @objects, $histspec if $histspec;
+ $data{format} = 'l' if ! exists $data{format};
+ }
unless (@objects) {
whine "No objects specified.";
$bad = 1;
}
#return help("show", $type) if $bad;
- return suggest_help("show", $type) if $bad;
+ return suggest_help("show", $type, $bad) if $bad;
my $r = submit("$REST/show", { id => \@objects, %data });
my $c = $r->content;
@@ -350,8 +441,17 @@ sub show {
# show ticket/id/attachments/id/content > foo.tar.gz
if ($r->content_type !~ /^text\//) {
chomp($c);
+ $rawprint = 1;
+ }
+ if ( $rawprint ) {
+ print $c;
+ } else {
+ # I do not know how to get more than one form correctly returned
+ $c =~ s!^RT/[\d\.]+ 200 Ok$!--!mg;
+ my $forms = Form::parse($c);
+ prettyshow ($forms);
}
- print $c;
+ return 0;
}
# To create a new object, we ask the server for a form with the defaults
@@ -373,6 +473,7 @@ sub edit {
while (@ARGV) {
$_ = shift @ARGV;
+ s/^#// if /^#\d+/; # get rid of leading hash
if (/^-e$/) { $edit = 1 }
elsif (/^-i$/) { $input = 1 }
@@ -397,7 +498,7 @@ sub edit {
elsif (/^set$/i) {
my $vars = 0;
- while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/) {
+ while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/s) {
my ($key, $op, $val) = ($1, $2, $3);
my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del;
@@ -415,7 +516,7 @@ sub edit {
my $vars = 0;
my $hash = ($_ eq "add") ? \%add : \%del;
- while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/) {
+ while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/s) {
my ($key, $val) = ($1, $2);
vpush($hash, lc $key, $val);
@@ -428,6 +529,9 @@ sub edit {
}
$cl = $vars;
}
+ elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
+ push @objects, $spc2;
+ }
elsif (my $spec = is_object_spec($_, $type)) {
push @objects, $spec;
}
@@ -453,10 +557,10 @@ sub edit {
whine "What type of object do you want to create?";
$bad = 1;
}
- @objects = ("$type/new");
+ @objects = ("$type/new") if defined($type);
}
#return help($action, $type) if $bad;
- return suggest_help($action, $type) if $bad;
+ return suggest_help($action, $type, $bad) 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
@@ -540,7 +644,7 @@ sub edit {
if ($output) {
print $text;
- return;
+ return 0;
}
my $synerr = 0;
@@ -566,11 +670,60 @@ EDIT:
}
else {
print $r->content;
- return;
+ return 0;
}
}
print $r->content;
}
+ return 0;
+}
+
+# handler for special edit commands. A valid edit command is constructed and
+# further work is delegated to the edit handler
+
+sub setcommand {
+ my ($action) = @_;
+ my ($id, $bad, $what);
+ if ( @ARGV ) {
+ $_ = shift @ARGV;
+ $id = $1 if (m|^(?:ticket/)?($idlist)$|);
+ }
+ if ( ! $id ) {
+ $bad = 1;
+ whine "No ticket number specified.";
+ }
+ if ( @ARGV ) {
+ if ($action eq 'subject') {
+ my $subject = '"'.join (" ", @ARGV).'"';
+ @ARGV = ();
+ $what = "subject=$subject";
+ } elsif ($action eq 'give') {
+ my $owner = shift @ARGV;
+ $what = "owner=$owner";
+ }
+ } else {
+ if ( $action eq 'delete' or $action eq 'del' ) {
+ $what = "status=deleted";
+ } elsif ($action eq 'resolve' or $action eq 'res' ) {
+ $what = "status=resolved";
+ } elsif ($action eq 'take' ) {
+ $what = "owner=$config{user}";
+ } elsif ($action eq 'untake') {
+ $what = "owner=Nobody";
+ }
+ }
+ if (@ARGV) {
+ $bad = 1;
+ whine "Extraneous arguments for action $action: @ARGV.";
+ }
+ if ( ! $what ) {
+ $bad = 1;
+ whine "unrecognized action $action.";
+ }
+ return help("edit", undef, $bad) if $bad;
+ @ARGV = ( $id, "set", $what );
+ print "Executing: rt edit @ARGV\n";
+ return edit("edit");
}
# We roll "comment" and "correspond" into the same handler.
@@ -595,7 +748,7 @@ sub comment {
if (/-a/) {
unless (-f $ARGV[0] && -r $ARGV[0]) {
whine "Cannot read attachment: '$ARGV[0]'.";
- return;
+ return 0;
}
push @files, shift @ARGV;
}
@@ -665,7 +818,7 @@ sub comment {
goto NEXT;
}
elsif (!@$o) {
- return;
+ return 0;
}
@files = @{ vsplit($k->{Attachment}) };
@@ -683,6 +836,7 @@ sub comment {
my $r = submit("$REST/ticket/$id/comment", \%data);
print $r->content;
+ return 0;
}
# Merge one ticket into another.
@@ -693,6 +847,7 @@ sub merge {
while (@ARGV) {
$_ = shift @ARGV;
+ s/^#// if /^#\d+/; # get rid of leading hash
if (/^\d+$/) {
push @id, $_;
@@ -709,16 +864,19 @@ sub merge {
$bad = 1;
}
#return help("merge", "ticket") if $bad;
- return suggest_help("merge", "ticket") if $bad;
+ return suggest_help("merge", "ticket", $bad) if $bad;
my $r = submit("$REST/ticket/$id[0]/merge/$id[1]");
print $r->content;
+ return 0;
}
# Link one ticket to another.
sub link {
my ($bad, $del, %data) = (0, 0, ());
+ my $type;
+
my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo
ReferredToBy HasMember MemberOf);
@@ -728,21 +886,26 @@ sub link {
if (/^-d$/) {
$del = 1;
}
+ elsif (/^-t$/) {
+ $bad = 1, last unless defined($type = get_type_argument());
+ }
else {
whine "Unrecognised option: '$_'.";
$bad = 1; last;
}
}
-
+
+ $type = "ticket" unless $type; # default type to tickets
+
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.";
+ whine "Invalid $type ID '$bad' specified.";
$bad = 1;
}
- unless (exists $ltypes{lc $rel}) {
- whine "Invalid link '$rel' specified.";
+ if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
+ whine "Invalid link '$rel' for type $type specified.";
$bad = 1;
}
%data = (id => $from, rel => $rel, to => $to, del => $del);
@@ -752,11 +915,11 @@ sub link {
whine "Too $bad arguments specified.";
$bad = 1;
}
- #return help("link", "ticket") if $bad;
- return suggest_help("link", "ticket") if $bad;
-
- my $r = submit("$REST/ticket/link", \%data);
+ return suggest_help("link", $type, $bad) if $bad;
+
+ my $r = submit("$REST/$type/link", \%data);
print $r->content;
+ return 0;
}
# Take/steal a ticket
@@ -791,10 +954,11 @@ sub take {
whine "Too $bad arguments specified.";
$bad = 1;
}
- return suggest_help("take", "ticket") if $bad;
+ return suggest_help("take", "ticket", $bad) if $bad;
my $r = submit("$REST/ticket/$id/take", \%data);
print $r->content;
+ return 0;
}
# Grant/revoke a user's rights.
@@ -807,6 +971,7 @@ sub grant {
}
$revoke = 1 if $cmd->{action} eq 'revoke';
+ return 0;
}
# Client <-> Server communication.
@@ -820,6 +985,7 @@ sub submit {
my ($uri, $content) = @_;
my ($req, $data);
my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1);
+ my $h = HTTP::Headers->new;
# Did the caller specify any data to send with the request?
$data = [];
@@ -845,9 +1011,22 @@ sub submit {
}
# 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() );
+ my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted';
+ (my $server = $config{server}) =~ s/^.*\/\/([^\/]+)\/?/$1/;
+ if ($config{externalauth}) {
+ $h->authorization_basic($config{user}, $config{passwd} || read_passwd() );
+ print " Password will be sent to $server $how\n",
+ " Press CTRL-C now if you do not want to continue\n"
+ if ! $config{passwd};
+ } elsif ( $no_strong_auth ) {
+ if (!defined $session->cookie) {
+ print " Strong encryption not available, $no_strong_auth\n",
+ " Password will be sent to $server $how\n",
+ " Press CTRL-C now if you do not want to continue\n"
+ if ! $config{passwd};
+ push @$data, ( user => $config{user} );
+ push @$data, ( pass => $config{passwd} || read_passwd() );
+ }
}
# Now, we construct the request.
@@ -858,6 +1037,9 @@ sub submit {
$req = GET($uri);
}
$session->add_cookie_header($req);
+ if ($config{externalauth}) {
+ $req->header(%$h);
+ }
# Then we send the request and parse the response.
DEBUG(3, $req->as_string);
@@ -874,7 +1056,7 @@ sub submit {
$text =~ s/\n*$/\n/ if ($text);
# "RT/3.0.1 401 Credentials required"
- if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) {
+ if ($status !~ m#^RT/\d+(?:\S+) (\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;
@@ -1043,7 +1225,7 @@ sub submit {
sub Form::parse {
my $state = 0;
my @forms = ();
- my @lines = split /\n/, $_[0];
+ my @lines = split /\n/, $_[0] if $_[0];
my ($c, $o, $k, $e) = ("", [], {}, "");
LINE:
@@ -1199,7 +1381,8 @@ sub Form::compose {
sub config_from_env {
my %env;
- foreach my $k ("DEBUG", "USER", "PASSWD", "SERVER", "QUERY", "ORDERBY") {
+ foreach my $k (qw(EXTERNALAUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) {
+
if (exists $ENV{"RT$k"}) {
$env{lc $k} = $ENV{"RT$k"};
}
@@ -1251,7 +1434,7 @@ sub parse_config_file {
chomp;
next if (/^#/ || /^\s*$/);
- if (/^(user|passwd|server|query|orderby)\s+(.*)\s?$/) {
+ if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
$cfg{$1} = $2;
}
else {
@@ -1270,7 +1453,7 @@ sub whine {
my $sub = (caller(1))[3];
$sub =~ s/^main:://;
warn "rt: $sub: @_\n";
- return;
+ return 0;
}
sub read_passwd {
@@ -1331,7 +1514,37 @@ sub vsplit {
# XXX: This should become a real parser, à la Text::ParseWords.
$line =~ s/^\s+//;
$line =~ s/\s+$//;
- push @words, split /\s*,\s*/, $line;
+ my ( $a, $b ) = split /,/, $line, 2;
+
+ while ($a) {
+ no warnings 'uninitialized';
+ if ( $a =~ /^'/ ) {
+ my $s = $a;
+ while ( $a !~ /'$/ || ( $a !~ /(\\\\)+'$/
+ && $a =~ /(\\)+'$/ )) {
+ ( $a, $b ) = split /,/, $b, 2;
+ $s .= ',' . $a;
+ }
+ push @words, $s;
+ }
+ elsif ( $a =~ /^q{/ ) {
+ my $s = $a;
+ while ( $a !~ /}$/ ) {
+ ( $a, $b ) =
+ split /,/, $b, 2;
+ $s .= ',' . $a;
+ }
+ $s =~ s/^q{/'/;
+ $s =~ s/}/'/;
+ push @words, $s;
+ }
+ else {
+ push @words, $a;
+ }
+ ( $a, $b ) = split /,/, $b, 2;
+ }
+
+
}
return \@words;
@@ -1406,14 +1619,130 @@ sub is_object_spec {
$spec =~ s|^(?:$type/)?|$type/| if defined $type;
return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o);
- return;
+ return 0;
}
sub suggest_help {
- my ($action, $type) = @_;
+ my ($action, $type, $rv) = @_;
print STDERR "rt: For help, run 'rt help $action'.\n" if defined $action;
print STDERR "rt: For help, run 'rt help $type'.\n" if defined $type;
+ return $rv;
+}
+
+sub str2time {
+ # simplified procedure for parsing date, avoid loading Date::Parse
+ my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5,
+ Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11);
+ $_ = shift;
+ my ($mon, $day, $hr, $min, $sec, $yr, $monstr);
+ if ( /(\w{3})\s+(\d\d?)\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/ ) {
+ ($monstr, $day, $hr, $min, $sec, $yr) = ($1, $2, $3, $4, $5, $6);
+ $mon = $month{$monstr} if exists $month{$monstr};
+ } elsif ( /(\d{4})-(\d\d)-(\d\d)\s+(\d\d):(\d\d):(\d\d)/ ) {
+ ($yr, $mon, $day, $hr, $min, $sec) = ($1, $2-1, $3, $4, $5, $6);
+ }
+ if ( $yr and defined $mon and $day and defined $hr and defined $sec ) {
+ return timelocal($sec,$min,$hr,$day,$mon,$yr);
+ } else {
+ print "Unknown date format in parsedate: $_\n";
+ return undef;
+ }
+}
+
+sub date_diff {
+ my ($old, $new) = @_;
+ $new = time() if ! $new;
+ $old = str2time($old) if $old !~ /^\d+$/;
+ $new = str2time($new) if $new !~ /^\d+$/;
+ return "???" if ! $old or ! $new;
+
+ my %seconds = (min => 60,
+ hr => 60*60,
+ day => 60*60*24,
+ wk => 60*60*24*7,
+ mth => 60*60*24*30,
+ yr => 60*60*24*365);
+
+ my $diff = $new - $old;
+ my $what = 'sec';
+ my $howmuch = $diff;
+ for ( sort {$seconds{$a} <=> $seconds{$b}} keys %seconds) {
+ last if $diff < $seconds{$_};
+ $what = $_;
+ $howmuch = int($diff/$seconds{$_});
+ }
+ return "$howmuch $what";
+}
+
+sub prettyshow {
+ my $forms = shift;
+ my ($form) = grep { exists $_->[2]->{Queue} } @$forms;
+ my $k = $form->[2];
+ # dates are in local time zone
+ if ( $k ) {
+ print "Date: $k->{Created}\n";
+ print "From: $k->{Requestors}\n";
+ print "Cc: $k->{Cc}\n" if $k->{Cc};
+ print "X-AdminCc: $k->{AdminCc}\n" if $k->{AdminCc};
+ print "X-Queue: $k->{Queue}\n";
+ print "Subject: [rt #$k->{id}] $k->{Subject}\n\n";
+ }
+ # dates in these attributes are in GMT and will be converted
+ foreach my $form (@$forms) {
+ my ($c, $o, $k, $e) = @$form;
+ next if ! $k->{id} or exists $k->{Queue};
+ if ( exists $k->{Created} ) {
+ my ($y,$m,$d,$hh,$mm,$ss) = ($k->{Created} =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/);
+ $m--;
+ my $created = localtime(timegm($ss,$mm,$hh,$d,$m,$y));
+ if ( exists $k->{Description} ) {
+ print "===> $k->{Description} on $created\n";
+ }
+ }
+ print "$k->{Content}\n" if exists $k->{Content} and
+ $k->{Content} !~ /to have no content$/ and
+ $k->{Type} ne 'EmailRecord';
+ print "$k->{Attachments}\n" if exists $k->{Attachments} and
+ $k->{Attachments};
+ }
+}
+
+sub prettylist {
+ my $forms = shift;
+ my $heading = "Ticket Owner Queue Age Told Status Requestor Subject\n";
+ $heading .= '-' x 80 . "\n";
+ my (@open, @me);
+ foreach my $form (@$forms) {
+ my ($c, $o, $k, $e) = @$form;
+ next if ! $k->{id};
+ print $heading if $heading;
+ $heading = '';
+ my $id = $k->{id};
+ $id =~ s!^ticket/!!;
+ my $owner = $k->{Owner} eq 'Nobody' ? '' : $k->{Owner};
+ $owner = substr($owner, 0, 5);
+ my $queue = substr($k->{Queue}, 0, 5);
+ my $subject = substr($k->{Subject}, 0, 30);
+ my $age = date_diff($k->{Created});
+ my $told = $k->{Told} eq 'Not set' ? '' : date_diff($k->{Told});
+ my $status = substr($k->{Status}, 0, 6);
+ my $requestor = substr($k->{Requestors}, 0, 9);
+ my $line = sprintf "%6s %5s %5s %6s %6s %-6s %-9s %-30s\n",
+ $id, $owner, $queue, $age, $told, $status, $requestor, $subject;
+ if ( $k->{Owner} eq 'Nobody' ) {
+ push @open, $line;
+ } elsif ($k->{Owner} eq $config{user} ) {
+ push @me, $line;
+ } else {
+ print $line;
+ }
+ }
+ print "No matches found\n" if $heading;
+ printf "========== my %2d open tickets ==========\n", scalar @me if @me;
+ print @me if @me;
+ printf "========== %2d unowned tickets ==========\n", scalar @open if @open;
+ print @open if @open;
}
__DATA__
@@ -1511,9 +1840,21 @@ Text:
- passwd <passwd> RT user's password.
- query <RT Query> Default RT Query for list action
- orderby <order> Default RT order for list action
+ - queue <queuename> Default RT Queue for list action
+ - externalauth <0|1> Use HTTP Basic authentication
+ explicitely setting externalauth to 0 inhibits also GSSAPI based
+ authentication, if LWP::Authen::Negotiate (and GSSAPI) is installed
Blank and #-commented lines are ignored.
+ Sample configuration file contents:
+
+ server https://rt.somewhere.com/
+ # more than one queue can be given (by adding a query expression)
+ queue helpdesk or queue=support
+ query Status != resolved and Owner=myaccount
+
+
Environment variables:
The following environment variables override any corresponding
@@ -1521,6 +1862,7 @@ Text:
- RTUSER
- RTPASSWD
+ - RTEXTERNALAUTH
- RTSERVER
- RTDEBUG Numeric debug level. (Set to 3 for full logs.)
- RTCONFIG Specifies a name other than ".rtrc" for the
@@ -1552,8 +1894,12 @@ Text:
"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-10".
+ If just a number is given as object specification it will be
+ interpreted as ticket/<number>
+
Examples:
+ 1 # the same as ticket/1
ticket/1
ticket/1/attachments
ticket/1/attachments/3
@@ -1591,6 +1937,22 @@ Text:
- rt help <action> (action-specific details)
- rt help types (a list of possible types)
+ The following actions on tickets are also possible:
+
+ - comment Add comments to a ticket
+ - correspond Add comments to a ticket
+ - merge Merge one ticket into another
+ - link Link one ticket to another
+ - take Take a ticket (steal and untake are possible as well)
+
+ For several edit set subcommands that are frequently used abbreviations
+ have been introduced. These abbreviations are:
+
+ - delete or del delete a ticket (edit set status=deleted)
+ - resolve or res resolve a ticket (edit set status=resolved)
+ - subject change subject of ticket (edit set subject=string)
+ - give give a ticket to somebody (edit set owner=user)
+
--
Title: types
@@ -1629,6 +1991,13 @@ Text:
- merge
- comment
- correspond
+ - take
+ - steal
+ - untake
+ - give
+ - resolve
+ - delete
+ - subject
Attributes:
@@ -1687,6 +2056,83 @@ Text:
--
+Title: subject
+Text:
+
+ Syntax:
+
+ rt subject <id> <new subject text>
+
+ Change the subject of a ticket whose ticket id is given.
+
+--
+
+Title: give
+Text:
+
+ Syntax:
+
+ rt give <id> <accountname>
+
+ Give a ticket whose ticket id is given to another user.
+
+--
+
+Title: steal
+Text:
+
+ rt steal <id>
+
+ Steal a ticket whose ticket id is given, i.e. set the owner to myself.
+
+--
+
+Title: take
+Text:
+
+ Syntax:
+
+ rt take <id>
+
+ Take a ticket whose ticket id is given, i.e. set the owner to myself.
+
+--
+
+Title: untake
+Text:
+
+ Syntax:
+
+ rt untake <id>
+
+ Untake a ticket whose ticket id is given, i.e. set the owner to Nobody.
+
+--
+
+Title: resolve
+Title: res
+Text:
+
+ Syntax:
+
+ rt resolve <id>
+
+ Resolves a ticket whose ticket id is given.
+
+--
+
+Title: delete
+Title: del
+Text:
+
+ Syntax:
+
+ rt delete <id>
+
+ Deletes a ticket whose ticket id is given.
+
+--
+
Title: logout
Text:
@@ -1725,24 +2171,30 @@ Text:
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.
+ -i Numeric IDs only. (Useful for |rt edit -; see examples.)
+ -s Short description.
+ -l Longer description.
+ -f <field[s] Display only the fields listed and the ticket id
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".)
+ -o +/-<field> Orders the returned list by the specified field.
+ -r reversed order (useful if a default was given)
+ -q queue[s] restricts the query to the queue[s] given
+ multiple queues are separated by comma
+ -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 "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]%'"
+ rt ls -q systems
+ rt ls -f owner,subject
--
@@ -1760,16 +2212,28 @@ Text:
that refers to the links for tickets 1-3). Consult "rt help <type>"
and "rt help objects" for further details.
+ If only a number is given it will be interpreted as the objects
+ ticket/number and ticket/number/history
+
This command writes a set of forms representing the requested object
data to STDOUT.
Options:
+ The following options control how much information is displayed
+ about each matching object:
+
+ Without any formatting options prettyprinted output is generated.
+ Giving any of the two options below reverts to raw output.
+ -s Short description (history and attachments only).
+ -l Longer description (history and attachments only).
+
+ In addition,
- 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.
- -v Verbose display
+
Examples:
rt show -t ticket -f id,subject,status 1-3
@@ -1777,8 +2241,9 @@ Text:
rt show ticket/3/attachments/29/content
rt show ticket/1-3/links
rt show ticket/3/history
- rt show -v ticket/3/history
+ rt show -l ticket/3/history
rt show -t user 2
+ rt show 2
--
@@ -1795,6 +2260,8 @@ Text:
Edits information corresponding to the specified objects.
+ A purely numeric object id nnn is translated into ticket/nnn
+
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
@@ -1834,7 +2301,7 @@ Text:
rt create -t ticket
# Non-interactive.
- rt edit ticket/1-3 add cc=foo@example.com set priority=3
+ rt edit ticket/1-3 add cc=foo@example.com set priority=3 due=tomorrow
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
@@ -1930,6 +2397,35 @@ Text:
(XXX: I'm going to have to write it, aren't I?)
+ Until it exists here a short description of important constructs:
+
+ The two simple forms of query expressions are the constructs
+ Attribute like Value and
+ Attribute = Value or Attribute != Value
+
+ Whether attributes can be matched using like or using = is built into RT.
+ The attributes id, Queue, Owner Priority and Status require the = or !=
+ tests.
+
+ If Value is a string it must be quoted and may contain the wildcard
+ character %. If the string does not contain white space, the quoting
+ may however be omitted, it will be added automatically when parsing
+ the input.
+
+ Simple query expressions can be combined using and, or and parentheses
+ can be used to group expressions.
+
+ As a special case a standalone string (which would not form a correct
+ query) is transformed into (Owner='string' or Requestor like 'string%')
+ and added to the default query, i.e. the query is narrowed down.
+
+ If no Queue=name clause is contained in the query, a default clause
+ Queue=$config{queue} is added.
+
+ Examples:
+ Status!='resolved' and Status!='rejected'
+ (Owner='myaccount' or Requestor like 'myaccount%') and Status!='resolved'
+
--
Title: form
@@ -1984,10 +2480,43 @@ 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.
+ some useful examples
+
+ All the following list requests will be restricted to the default queue.
+ That can be changed by adding the option -q queuename
+
+ List all tickets that are not rejected/resolved
+ rt ls
+ List all tickets that are new and do not have an owner
+ rt ls "status=new and owner=nobody"
+ List all tickets which I have sent or of which I am the owner
+ rt ls myaccount
+ List all attributes for the ticket 6977 (ls -l instead of ls)
+ rt ls -l 6977
+ Show the content of ticket 6977
+ rt show 6977
+ Show all attributes in the ticket and in the history of the ticket
+ rt show -l 6977
+ Comment a ticket (mail is sent to all queue watchers, i.e. AdminCc's)
+ rt comment 6977
+ This will open an editor and lets you add text (attribute Text:)
+ Other attributes may be changed as well, but usually don't do that.
+ Correspond a ticket (like comment, but mail is also sent to requestors)
+ rt correspond 6977
+ Edit a ticket (generic change, interactive using the editor)
+ rt edit 6977
+ Change the owner of a ticket non interactively
+ rt edit 6977 set owner=myaccount
+ or
+ rt give 6977 account
+ or
+ rt take 6977
+ Change the status of a ticket
+ rt edit 6977 set status=resolved
+ or
+ rt resolve 6977
+ Change the status of all tickets I own to resolved !!!
+ rt ls -i owner=myaccount | rt edit - set status=resolved
--
diff --git a/rt/bin/rt-crontool b/rt/bin/rt-crontool
index 3171d115c..563a272fa 100644
--- a/rt/bin/rt-crontool
+++ b/rt/bin/rt-crontool
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -49,9 +49,32 @@
use strict;
use Carp;
-use lib ("/opt/rt3/local/lib", "/opt/rt3/lib");
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("lib", "local/lib");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
-package RT;
+}
+
+use RT;
use Getopt::Long;
@@ -62,54 +85,66 @@ use RT::Template;
#Clean out all the nasties from the environment
CleanEnv();
+my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
+ $template, $template_id, $transaction, $transaction_type, $help, $log, $verbose );
+GetOptions(
+ "search=s" => \$search,
+ "search-arg=s" => \$search_arg,
+ "condition=s" => \$condition,
+ "condition-arg=s" => \$condition_arg,
+ "action-arg=s" => \$action_arg,
+ "action=s" => \$action,
+ "template=s" => \$template,
+ "template-id=s" => \$template_id,
+ "transaction=s" => \$transaction,
+ "transaction-type=s" => \$transaction_type,
+ "log=s" => \$log,
+ "verbose|v" => \$verbose,
+ "help" => \$help,
+);
+
# Load the config file
RT::LoadConfig();
+# adjust logging to the screen according to options
+RT->Config->Set( LogToScreen => $log ) if $log;
+
#Connect to the database and get RT::SystemUser and RT::Nobody loaded
RT::Init();
#Get the current user all loaded
my $CurrentUser = GetCurrentUser();
+# show help even if there is no current user
+help() if $help;
+
unless ( $CurrentUser->Id ) {
print loc("No RT user found. Please consult your RT administrator.\n");
exit(1);
}
-my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
- $template_id, $transaction, $transaction_type, $help, $verbose );
-GetOptions( "search=s" => \$search,
- "search-arg=s" => \$search_arg,
- "condition=s" => \$condition,
- "condition-arg=s" => \$condition_arg,
- "action-arg=s" => \$action_arg,
- "action=s" => \$action,
- "template-id=s" => \$template_id,
- "transaction=s" => \$transaction,
- "transaction-type=s" => \$transaction_type,
- "help" => \$help,
- "verbose|v" => \$verbose );
-
-help() if $help or not $search or not $action;
-
-$transaction ||= 'first';
-unless ( $transaction =~ /^(first|last)$/i ) {
- print STDERR loc("--transaction argument could be only 'first' or 'last'");
+help() unless $search && $action;
+
+$transaction = lc( $transaction||'' );
+if ( $transaction && $transaction !~ /^(first|all|last)$/i ) {
+ print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'");
+ exit 1;
+}
+
+if ( $template && $template_id ) {
+ print STDERR loc("--template-id is deprecated argument and can not be used with --template");
exit 1;
}
-$transaction = lc($transaction) eq 'first'? 'ASC': 'DESC';
+elsif ( $template_id ) {
+# don't warn
+ $template = $template_id;
+}
# We _must_ have a search object
load_module($search);
load_module($action) if ($action);
load_module($condition) if ($condition);
-# load template if specified
-my $template_obj;
-if ($template_id) {
- $template_obj = RT::Template->new($CurrentUser);
- $template_obj->Load($template_id);
-}
my $void_scrip = RT::Scrip->new( $CurrentUser );
my $void_scrip_action = RT::ScripAction->new( $CurrentUser );
@@ -132,9 +167,31 @@ my $tickets = $search->TicketsObj;
while ( my $ticket = $tickets->Next() ) {
print $ticket->Id() . ": " if ($verbose);
- my $transaction = get_transaction($ticket);
- print loc("Using transaction #[_1]...", $transaction->id)
- if $verbose && $transaction;
+ my $template_obj = get_template( $ticket );
+
+ if ( $transaction ) {
+ my $txns = get_transactions($ticket);
+ my $found = 0;
+ while ( my $txn = $txns->Next ) {
+ print loc("Using transaction #[_1]...", $txn->id)
+ if $verbose;
+ process($ticket, $txn, $template_obj);
+ $found = 1;
+ }
+ print loc("Couldn't find suitable transaction, skipping")
+ if $verbose && !$found;
+ } else {
+ print loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")
+ if $verbose;
+
+ process($ticket, undef, $template_obj);
+ }
+}
+
+sub process {
+ my $ticket = shift;
+ my $transaction = shift;
+ my $template_obj = shift;
# perform some more advanced check
if ($condition) {
@@ -149,8 +206,8 @@ while ( my $ticket = $tickets->Next() ) {
# if the condition doesn't apply, get out of here
- next unless ( $condition_obj->IsApplicable );
- print loc("Condition matches...") if ($verbose);
+ return unless $condition_obj->IsApplicable;
+ print loc("Condition matches...") if $verbose;
}
#prepare our action
@@ -165,34 +222,76 @@ while ( my $ticket = $tickets->Next() ) {
);
#if our preparation, move onto the next ticket
- next unless ( $action_obj->Prepare );
- print loc("Action prepared...") if ($verbose);
+ return unless $action_obj->Prepare;
+ print loc("Action prepared...") if $verbose;
#commit our action.
- next unless ( $action_obj->Commit );
- print loc("Action committed.\n") if ($verbose);
+ return unless $action_obj->Commit;
+ print loc("Action committed.\n") if $verbose;
}
-=head2 get_transaction
+=head2 get_transactions
-Takes ticket and returns its transaction acording to command
-line arguments C<--transaction> and <--transaction-type>.
+Takes ticket and returns L<RT::Transactions> object with transactions
+of the ticket according to command line arguments C<--transaction>
+and <--transaction-type>.
=cut
-sub get_transaction {
+sub get_transactions {
my $ticket = shift;
my $txns = $ticket->Transactions;
+ my $order = $transaction eq 'last'? 'DESC': 'ASC';
$txns->OrderByCols(
- { FIELD => 'Created', ORDER => $transaction },
- { FIELD => 'id', ORDER => $transaction },
+ { FIELD => 'Created', ORDER => $order },
+ { FIELD => 'id', ORDER => $order },
);
- $txns->Limit( FIELD => 'Type', VALUE => $transaction_type )
- if $transaction_type;
- $txns->RowsPerPage(1);
- return $txns->First;
+ if ( $transaction_type ) {
+ $transaction_type =~ s/^\s+//;
+ $transaction_type =~ s/\s+$//;
+ foreach my $type ( split /\s*,\s*/, $transaction_type ) {
+ $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' );
+ }
+ }
+ $txns->RowsPerPage(1) unless $transaction eq 'all';
+ return $txns;
}
+=head2 get_template
+
+Takes a ticket and returns a template according to command line options.
+
+=cut
+
+{ my $cache = undef;
+sub get_template {
+ my $ticket = shift;
+ return undef unless $template;
+
+ unless ( $template =~ /\D/ ) {
+ # by id
+ return $cache if $cache;
+
+ my $cache = RT::Template->new( $RT::SystemUser );
+ $cache->Load( $template );
+ die "Failed to load template '$template'"
+ unless $cache->id;
+ return $cache;
+ }
+
+ my $queue = $ticket->Queue;
+ return $cache->{ $queue } if $cache->{ $queue };
+
+ my $res = RT::Template->new( $RT::SystemUser );
+ $res->LoadQueueTemplate( Queue => $queue, Name => $template );
+ unless ( $res->id ) {
+ $res->LoadGlobalTemplate( $template );
+ die "Failed to load template '$template', either for queue #$queue or global"
+ unless $res->id;
+ }
+ return $cache->{ $queue } = $res;
+} }
+
# {{{ load_module
=head2 load_module
@@ -236,31 +335,33 @@ sub help {
. loc( "[_1] - Specify the search module you want to use", "--search" )
. "\n";
print " "
- . loc( "[_1] - An argument to pass to [_2]", "--search-argument", "--search" )
+ . loc( "[_1] - An argument to pass to [_2]", "--search-arg", "--search" )
. "\n";
print " "
. loc( "[_1] - Specify the condition module you want to use", "--condition" )
. "\n";
print " "
- . loc( "[_1] - An argument to pass to [_2]", "--condition-argument", "--condition" )
+ . loc( "[_1] - An argument to pass to [_2]", "--condition-arg", "--condition" )
. "\n";
print " "
. loc( "[_1] - Specify the action module you want to use", "--action" )
. "\n";
print " "
- . loc( "[_1] - An argument to pass to [_2]", "--action-argument", "--action" )
+ . loc( "[_1] - An argument to pass to [_2]", "--action-arg", "--action" )
. "\n";
print " "
- . loc( "[_1] - Specify id of the template you want to use", "--template-id" )
+ . loc( "[_1] - Specify name or id of template(s) you want to use", "--template" )
. "\n";
print " "
- . loc( "[_1] - Specify if you want to use either 'first' or 'last' transaction", "--transaction" )
+ . loc( "[_1] - Specify if you want to use either 'first', 'last' or 'all' transactions", "--transaction" )
. "\n";
print " "
- . loc( "[_1] - Specify the type of a transaction you want to use", "--transaction-type" )
+ . loc( "[_1] - Specify the comma separated list of transactions' types you want to use", "--transaction-type" )
. "\n";
print " "
+ . loc( "[_1] - Adjust LogToScreen config option", "--log" ) . "\n";
+ print " "
. loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n";
print "\n";
print "\n";
diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in
index 07e7a8b52..8401acab3 100644
--- a/rt/bin/rt-crontool.in
+++ b/rt/bin/rt-crontool.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -49,9 +49,32 @@
use strict;
use Carp;
-use lib ("@LOCAL_LIB_PATH@", "@RT_LIB_PATH@");
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
-package RT;
+}
+
+use RT;
use Getopt::Long;
@@ -62,54 +85,66 @@ use RT::Template;
#Clean out all the nasties from the environment
CleanEnv();
+my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
+ $template, $template_id, $transaction, $transaction_type, $help, $log, $verbose );
+GetOptions(
+ "search=s" => \$search,
+ "search-arg=s" => \$search_arg,
+ "condition=s" => \$condition,
+ "condition-arg=s" => \$condition_arg,
+ "action-arg=s" => \$action_arg,
+ "action=s" => \$action,
+ "template=s" => \$template,
+ "template-id=s" => \$template_id,
+ "transaction=s" => \$transaction,
+ "transaction-type=s" => \$transaction_type,
+ "log=s" => \$log,
+ "verbose|v" => \$verbose,
+ "help" => \$help,
+);
+
# Load the config file
RT::LoadConfig();
+# adjust logging to the screen according to options
+RT->Config->Set( LogToScreen => $log ) if $log;
+
#Connect to the database and get RT::SystemUser and RT::Nobody loaded
RT::Init();
#Get the current user all loaded
my $CurrentUser = GetCurrentUser();
+# show help even if there is no current user
+help() if $help;
+
unless ( $CurrentUser->Id ) {
print loc("No RT user found. Please consult your RT administrator.\n");
exit(1);
}
-my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
- $template_id, $transaction, $transaction_type, $help, $verbose );
-GetOptions( "search=s" => \$search,
- "search-arg=s" => \$search_arg,
- "condition=s" => \$condition,
- "condition-arg=s" => \$condition_arg,
- "action-arg=s" => \$action_arg,
- "action=s" => \$action,
- "template-id=s" => \$template_id,
- "transaction=s" => \$transaction,
- "transaction-type=s" => \$transaction_type,
- "help" => \$help,
- "verbose|v" => \$verbose );
-
-help() if $help or not $search or not $action;
-
-$transaction ||= 'first';
-unless ( $transaction =~ /^(first|last)$/i ) {
- print STDERR loc("--transaction argument could be only 'first' or 'last'");
+help() unless $search && $action;
+
+$transaction = lc( $transaction||'' );
+if ( $transaction && $transaction !~ /^(first|all|last)$/i ) {
+ print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'");
+ exit 1;
+}
+
+if ( $template && $template_id ) {
+ print STDERR loc("--template-id is deprecated argument and can not be used with --template");
exit 1;
}
-$transaction = lc($transaction) eq 'first'? 'ASC': 'DESC';
+elsif ( $template_id ) {
+# don't warn
+ $template = $template_id;
+}
# We _must_ have a search object
load_module($search);
load_module($action) if ($action);
load_module($condition) if ($condition);
-# load template if specified
-my $template_obj;
-if ($template_id) {
- $template_obj = RT::Template->new($CurrentUser);
- $template_obj->Load($template_id);
-}
my $void_scrip = RT::Scrip->new( $CurrentUser );
my $void_scrip_action = RT::ScripAction->new( $CurrentUser );
@@ -132,9 +167,31 @@ my $tickets = $search->TicketsObj;
while ( my $ticket = $tickets->Next() ) {
print $ticket->Id() . ": " if ($verbose);
- my $transaction = get_transaction($ticket);
- print loc("Using transaction #[_1]...", $transaction->id)
- if $verbose && $transaction;
+ my $template_obj = get_template( $ticket );
+
+ if ( $transaction ) {
+ my $txns = get_transactions($ticket);
+ my $found = 0;
+ while ( my $txn = $txns->Next ) {
+ print loc("Using transaction #[_1]...", $txn->id)
+ if $verbose;
+ process($ticket, $txn, $template_obj);
+ $found = 1;
+ }
+ print loc("Couldn't find suitable transaction, skipping")
+ if $verbose && !$found;
+ } else {
+ print loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")
+ if $verbose;
+
+ process($ticket, undef, $template_obj);
+ }
+}
+
+sub process {
+ my $ticket = shift;
+ my $transaction = shift;
+ my $template_obj = shift;
# perform some more advanced check
if ($condition) {
@@ -149,8 +206,8 @@ while ( my $ticket = $tickets->Next() ) {
# if the condition doesn't apply, get out of here
- next unless ( $condition_obj->IsApplicable );
- print loc("Condition matches...") if ($verbose);
+ return unless $condition_obj->IsApplicable;
+ print loc("Condition matches...") if $verbose;
}
#prepare our action
@@ -165,34 +222,76 @@ while ( my $ticket = $tickets->Next() ) {
);
#if our preparation, move onto the next ticket
- next unless ( $action_obj->Prepare );
- print loc("Action prepared...") if ($verbose);
+ return unless $action_obj->Prepare;
+ print loc("Action prepared...") if $verbose;
#commit our action.
- next unless ( $action_obj->Commit );
- print loc("Action committed.\n") if ($verbose);
+ return unless $action_obj->Commit;
+ print loc("Action committed.\n") if $verbose;
}
-=head2 get_transaction
+=head2 get_transactions
-Takes ticket and returns its transaction acording to command
-line arguments C<--transaction> and <--transaction-type>.
+Takes ticket and returns L<RT::Transactions> object with transactions
+of the ticket according to command line arguments C<--transaction>
+and <--transaction-type>.
=cut
-sub get_transaction {
+sub get_transactions {
my $ticket = shift;
my $txns = $ticket->Transactions;
+ my $order = $transaction eq 'last'? 'DESC': 'ASC';
$txns->OrderByCols(
- { FIELD => 'Created', ORDER => $transaction },
- { FIELD => 'id', ORDER => $transaction },
+ { FIELD => 'Created', ORDER => $order },
+ { FIELD => 'id', ORDER => $order },
);
- $txns->Limit( FIELD => 'Type', VALUE => $transaction_type )
- if $transaction_type;
- $txns->RowsPerPage(1);
- return $txns->First;
+ if ( $transaction_type ) {
+ $transaction_type =~ s/^\s+//;
+ $transaction_type =~ s/\s+$//;
+ foreach my $type ( split /\s*,\s*/, $transaction_type ) {
+ $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' );
+ }
+ }
+ $txns->RowsPerPage(1) unless $transaction eq 'all';
+ return $txns;
}
+=head2 get_template
+
+Takes a ticket and returns a template according to command line options.
+
+=cut
+
+{ my $cache = undef;
+sub get_template {
+ my $ticket = shift;
+ return undef unless $template;
+
+ unless ( $template =~ /\D/ ) {
+ # by id
+ return $cache if $cache;
+
+ my $cache = RT::Template->new( $RT::SystemUser );
+ $cache->Load( $template );
+ die "Failed to load template '$template'"
+ unless $cache->id;
+ return $cache;
+ }
+
+ my $queue = $ticket->Queue;
+ return $cache->{ $queue } if $cache->{ $queue };
+
+ my $res = RT::Template->new( $RT::SystemUser );
+ $res->LoadQueueTemplate( Queue => $queue, Name => $template );
+ unless ( $res->id ) {
+ $res->LoadGlobalTemplate( $template );
+ die "Failed to load template '$template', either for queue #$queue or global"
+ unless $res->id;
+ }
+ return $cache->{ $queue } = $res;
+} }
+
# {{{ load_module
=head2 load_module
@@ -236,31 +335,33 @@ sub help {
. loc( "[_1] - Specify the search module you want to use", "--search" )
. "\n";
print " "
- . loc( "[_1] - An argument to pass to [_2]", "--search-argument", "--search" )
+ . loc( "[_1] - An argument to pass to [_2]", "--search-arg", "--search" )
. "\n";
print " "
. loc( "[_1] - Specify the condition module you want to use", "--condition" )
. "\n";
print " "
- . loc( "[_1] - An argument to pass to [_2]", "--condition-argument", "--condition" )
+ . loc( "[_1] - An argument to pass to [_2]", "--condition-arg", "--condition" )
. "\n";
print " "
. loc( "[_1] - Specify the action module you want to use", "--action" )
. "\n";
print " "
- . loc( "[_1] - An argument to pass to [_2]", "--action-argument", "--action" )
+ . loc( "[_1] - An argument to pass to [_2]", "--action-arg", "--action" )
. "\n";
print " "
- . loc( "[_1] - Specify id of the template you want to use", "--template-id" )
+ . loc( "[_1] - Specify name or id of template(s) you want to use", "--template" )
. "\n";
print " "
- . loc( "[_1] - Specify if you want to use either 'first' or 'last' transaction", "--transaction" )
+ . loc( "[_1] - Specify if you want to use either 'first', 'last' or 'all' transactions", "--transaction" )
. "\n";
print " "
- . loc( "[_1] - Specify the type of a transaction you want to use", "--transaction-type" )
+ . loc( "[_1] - Specify the comma separated list of transactions' types you want to use", "--transaction-type" )
. "\n";
print " "
+ . loc( "[_1] - Adjust LogToScreen config option", "--log" ) . "\n";
+ print " "
. loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n";
print "\n";
print "\n";
diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate
index a578b4bc6..abe731196 100755
--- a/rt/bin/rt-mailgate
+++ b/rt/bin/rt-mailgate
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -52,30 +52,34 @@ rt-mailgate - Mail interface to RT3.
=cut
-
use strict;
use warnings;
+
use Getopt::Long;
use LWP::UserAgent;
+use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+$DYNAMIC_FILE_UPLOAD = 1;
use constant EX_TEMPFAIL => 75;
+use constant BUFFER_SIZE => 8192;
my %opts;
GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
-if ( $opts{help} ) {
+if ( $opts{'help'} ) {
require Pod::Usage;
import Pod::Usage;
pod2usage("RT Mail Gateway\n");
exit 1; # Don't want to succeed if this is really an email!
}
-for (qw(url)) {
- die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_};
+unless ( $opts{'url'} ) {
+ print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
+ exit 1;
}
-my $ua = LWP::UserAgent->new();
-$ua->cookie_jar( { file => $opts{jar} } );
+my $ua = new LWP::UserAgent;
+$ua->cookie_jar( { file => $opts{'jar'} } ) if $opts{'jar'};
my %args = (
SessionType => 'REST', # Surpress login box
@@ -84,37 +88,54 @@ foreach ( qw(queue action) ) {
$args{$_} = $opts{$_} if defined $opts{$_};
};
-# Read the message in from STDIN
-$args{'message'} = do { local (@ARGV, $/); <> };
-
-unless ( $args{message} =~ /\S/ ) {
- print STDERR "$0: no message passed on STDIN!\n";
- exit 0;
+if ( ($opts{'extension'} || '') =~ /^(?:action|queue|ticket)$/i ) {
+ $args{ lc $opts{'extension'} } = $ENV{'EXTENSION'} || $opts{$opts{'extension'}};
+} elsif ( $opts{'extension'} && $ENV{'EXTENSION'} ) {
+ print STDERR "Value of the --extension argument is not action, queue or ticket"
+ .", but environment variable EXTENSION is also defined. The former is ignored.\n";
}
-if ($opts{'extension'}) {
- $args{$opts{'extension'}} = $ENV{'EXTENSION'};
+# add ENV{'EXTENSION'} as X-RT-MailExtension to the message header
+if ( my $value = ( $ENV{'EXTENSION'} || $opts{'extension'} ) ) {
+ # prepare value to avoid MIME format breakage
+ # strip trailing newline symbols
+ $value =~ s/(\r*\n)+$//;
+ # make a correct multiline header field,
+ # with tabs in the beginning of each line
+ $value =~ s/(\r*\n)/$1\t/g;
+ $opts{'headers'} .= "X-RT-Mail-Extension: $value\n";
}
-# Set up cookie here.
+# Read the message in from STDIN
+my %message = write_down_message();
+unless( $message{'filename'} ) {
+ $args{'message'} = [
+ undef, '',
+ 'Content-Type' => 'application/octet-stream',
+ Content => ${ $message{'content'} },
+ ];
+} else {
+ $args{'message'} = [
+ $message{'filename'}, '',
+ 'Content-Type' => 'application/octet-stream',
+ ];
+}
my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
-warn "Connecting to $full_url" if $opts{'debug'};
+print STDERR "$0: connecting to $full_url\n" if $opts{'debug'};
-
-
-$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180);
-my $r = $ua->post( $full_url, {%args} );
+$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 );
+my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' );
check_failure($r);
my $content = $r->content;
-warn $content if ($opts{debug});
+print STDERR $content ."\n" if $opts{'debug'};
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.
- warn <<EOF;
+ print STDERR <<EOF;
RT server error.
The RT server which handled your email did not behave as expected. It
@@ -123,16 +144,19 @@ said:
$content
EOF
-exit EX_TEMPFAIL;
-
+ exit EX_TEMPFAIL;
}
exit;
+END {
+ unlink $message{'filename'} if $message{'filename'};
+}
+
sub check_failure {
my $r = shift;
- return if $r->is_success();
+ return if $r->is_success;
# This ordinarily oughtn't to be able to happen, suggests a bug in RT.
# So only load these heavy modules when they're needed.
@@ -140,17 +164,64 @@ sub check_failure {
require HTML::FormatText;
my $error = $r->error_as_HTML;
- my $tree = HTML::TreeBuilder->new->parse($error);
+ my $tree = HTML::TreeBuilder->new->parse( $error );
$tree->eof;
# It'll be a cold day in hell before RT sends out bounces in HTML
- my $formatter = HTML::FormatText->new( leftmargin => 0,
- rightmargin => 50 );
- warn $formatter->format($tree);
- warn "This is $0 exiting because of an undefined server error" if ($opts{debug});
+ my $formatter = HTML::FormatText->new(
+ leftmargin => 0,
+ rightmargin => 50,
+ );
+ print STDERR $formatter->format( $tree );
+ print STDERR "\n$0: undefined server error\n" if $opts{'debug'};
exit EX_TEMPFAIL;
}
+sub write_down_message {
+ use File::Temp qw(tempfile);
+
+ local $@;
+ my ($fh, $filename) = eval { tempfile() };
+ if ( !$fh || $@ ) {
+ print STDERR "$0: Couldn't create temp file, using memory\n";
+ print STDERR "error: $@\n" if $@;
+
+ my $message = \do { local (@ARGV, $/); <> };
+ unless ( $$message =~ /\S/ ) {
+ print STDERR "$0: no message passed on STDIN\n";
+ exit 0;
+ }
+ $$message = $opts{'headers'} . $$message if $opts{'headers'};
+ return ( content => $message );
+ }
+
+ binmode $fh;
+ binmode \*STDIN;
+
+ print $fh $opts{'headers'} if $opts{'headers'};
+
+ my $buf; my $empty = 1;
+ while(1) {
+ my $status = read \*STDIN, $buf, BUFFER_SIZE;
+ unless ( defined $status ) {
+ print STDERR "$0: couldn't read message: $!\n";
+ exit EX_TEMPFAIL;
+ } elsif ( !$status ) {
+ last;
+ }
+ $empty = 0 if $buf =~ /\S/;
+ print $fh $buf;
+ };
+ close $fh;
+
+ if ( $empty ) {
+ print STDERR "$0: no message passed on STDIN\n";
+ exit 0;
+ }
+ print STDERR "$0: temp file is '$filename'\n" if $opts{'debug'};
+ return (filename => $filename);
+}
+
=head1 SYNOPSIS
@@ -166,8 +237,6 @@ Usual invocation (from MTA):
-See C<man rt-mailgate> for more.
-
=head1 OPTIONS
=over 3
@@ -178,7 +247,7 @@ Specifies what happens to email sent to this alias. The avaliable
basic actions are: C<correspond>, C<comment>.
-If you've set the RT configuration variable B<$RT::UnsafeEmailCommands>,
+If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>,
C<take> and C<resolve> are also available. You can execute two or more
actions on a single message using a C<-> separated list. RT will execute
the actions in the listed order. For example you can use C<take-comment>,
@@ -259,13 +328,13 @@ there are situations in which you will want to authenticate users
before allowing them to communicate with the system. You can do this
via a plug-in mechanism in the RT configuration.
-You can set the array C<@RT::MailPlugins> to be a list of plugins. The
+You can set the array C<@MailPlugins> to be a list of plugins. The
default plugin, if this is not given, is C<Auth::MailFrom> - that is,
authentication of the person is done based on the C<From> header of the
email. If you have additional filters or authentication mechanisms, you
can list them here and they will be called in order:
- @RT::MailPlugins = (
+ Set( @MailPlugins =>
"Filter::SpamAssassin",
"Auth::LDAP",
# ...
@@ -273,12 +342,12 @@ can list them here and they will be called in order:
See the documentation for any additional plugins you have.
-You may also put Perl subroutines into the C<@RT::MailPlugins> array, if
+You may also put Perl subroutines into the C<@MailPlugins> array, if
they behave as described below.
=head1 WRITING PLUGINS
-What's actually going on in the above is that C<@RT::MailPlugins> is a
+What's actually going on in the above is that C<@MailPlugins> is a
list of Perl modules; RT prepends C<RT::Interface::Email::> to the name,
to form a package name, and then C<use>'s this module. The module is
expected to provide a C<GetCurrentUser> subroutine, which takes a hash of
@@ -319,5 +388,22 @@ the correspondent) or one, which is the normal mode of operation.
Additionally, if C<-1> is returned, then the processing of the plug-ins
stops immediately and the message is ignored.
+=head1 ENVIRONMENT
+
+=over 4
+
+=item EXTENSION
+
+Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
+and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value
+of this variable to message in the C<X-RT-Mail-Extension> field of the message
+header.
+
+See also C<--extension> option. Note that value of the environment variable is
+always added to the message header when it's not empty even if C<--extension>
+option is not provided.
+
+=back 4
+
=cut
diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in
index 49c4facfe..b2343a0f5 100644
--- a/rt/bin/rt-mailgate.in
+++ b/rt/bin/rt-mailgate.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -52,30 +52,34 @@ rt-mailgate - Mail interface to RT3.
=cut
-
use strict;
use warnings;
+
use Getopt::Long;
use LWP::UserAgent;
+use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+$DYNAMIC_FILE_UPLOAD = 1;
use constant EX_TEMPFAIL => 75;
+use constant BUFFER_SIZE => 8192;
my %opts;
GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
-if ( $opts{help} ) {
+if ( $opts{'help'} ) {
require Pod::Usage;
import Pod::Usage;
pod2usage("RT Mail Gateway\n");
exit 1; # Don't want to succeed if this is really an email!
}
-for (qw(url)) {
- die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_};
+unless ( $opts{'url'} ) {
+ print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
+ exit 1;
}
-my $ua = LWP::UserAgent->new();
-$ua->cookie_jar( { file => $opts{jar} } );
+my $ua = new LWP::UserAgent;
+$ua->cookie_jar( { file => $opts{'jar'} } ) if $opts{'jar'};
my %args = (
SessionType => 'REST', # Surpress login box
@@ -84,37 +88,54 @@ foreach ( qw(queue action) ) {
$args{$_} = $opts{$_} if defined $opts{$_};
};
-# Read the message in from STDIN
-$args{'message'} = do { local (@ARGV, $/); <> };
-
-unless ( $args{message} =~ /\S/ ) {
- print STDERR "$0: no message passed on STDIN!\n";
- exit 0;
+if ( ($opts{'extension'} || '') =~ /^(?:action|queue|ticket)$/i ) {
+ $args{ lc $opts{'extension'} } = $ENV{'EXTENSION'} || $opts{$opts{'extension'}};
+} elsif ( $opts{'extension'} && $ENV{'EXTENSION'} ) {
+ print STDERR "Value of the --extension argument is not action, queue or ticket"
+ .", but environment variable EXTENSION is also defined. The former is ignored.\n";
}
-if ($opts{'extension'}) {
- $args{$opts{'extension'}} = $ENV{'EXTENSION'};
+# add ENV{'EXTENSION'} as X-RT-MailExtension to the message header
+if ( my $value = ( $ENV{'EXTENSION'} || $opts{'extension'} ) ) {
+ # prepare value to avoid MIME format breakage
+ # strip trailing newline symbols
+ $value =~ s/(\r*\n)+$//;
+ # make a correct multiline header field,
+ # with tabs in the beginning of each line
+ $value =~ s/(\r*\n)/$1\t/g;
+ $opts{'headers'} .= "X-RT-Mail-Extension: $value\n";
}
-# Set up cookie here.
+# Read the message in from STDIN
+my %message = write_down_message();
+unless( $message{'filename'} ) {
+ $args{'message'} = [
+ undef, '',
+ 'Content-Type' => 'application/octet-stream',
+ Content => ${ $message{'content'} },
+ ];
+} else {
+ $args{'message'} = [
+ $message{'filename'}, '',
+ 'Content-Type' => 'application/octet-stream',
+ ];
+}
my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
-warn "Connecting to $full_url" if $opts{'debug'};
+print STDERR "$0: connecting to $full_url\n" if $opts{'debug'};
-
-
-$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180);
-my $r = $ua->post( $full_url, {%args} );
+$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 );
+my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' );
check_failure($r);
my $content = $r->content;
-warn $content if ($opts{debug});
+print STDERR $content ."\n" if $opts{'debug'};
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.
- warn <<EOF;
+ print STDERR <<EOF;
RT server error.
The RT server which handled your email did not behave as expected. It
@@ -123,16 +144,19 @@ said:
$content
EOF
-exit EX_TEMPFAIL;
-
+ exit EX_TEMPFAIL;
}
exit;
+END {
+ unlink $message{'filename'} if $message{'filename'};
+}
+
sub check_failure {
my $r = shift;
- return if $r->is_success();
+ return if $r->is_success;
# This ordinarily oughtn't to be able to happen, suggests a bug in RT.
# So only load these heavy modules when they're needed.
@@ -140,17 +164,64 @@ sub check_failure {
require HTML::FormatText;
my $error = $r->error_as_HTML;
- my $tree = HTML::TreeBuilder->new->parse($error);
+ my $tree = HTML::TreeBuilder->new->parse( $error );
$tree->eof;
# It'll be a cold day in hell before RT sends out bounces in HTML
- my $formatter = HTML::FormatText->new( leftmargin => 0,
- rightmargin => 50 );
- warn $formatter->format($tree);
- warn "This is $0 exiting because of an undefined server error" if ($opts{debug});
+ my $formatter = HTML::FormatText->new(
+ leftmargin => 0,
+ rightmargin => 50,
+ );
+ print STDERR $formatter->format( $tree );
+ print STDERR "\n$0: undefined server error\n" if $opts{'debug'};
exit EX_TEMPFAIL;
}
+sub write_down_message {
+ use File::Temp qw(tempfile);
+
+ local $@;
+ my ($fh, $filename) = eval { tempfile() };
+ if ( !$fh || $@ ) {
+ print STDERR "$0: Couldn't create temp file, using memory\n";
+ print STDERR "error: $@\n" if $@;
+
+ my $message = \do { local (@ARGV, $/); <> };
+ unless ( $$message =~ /\S/ ) {
+ print STDERR "$0: no message passed on STDIN\n";
+ exit 0;
+ }
+ $$message = $opts{'headers'} . $$message if $opts{'headers'};
+ return ( content => $message );
+ }
+
+ binmode $fh;
+ binmode \*STDIN;
+
+ print $fh $opts{'headers'} if $opts{'headers'};
+
+ my $buf; my $empty = 1;
+ while(1) {
+ my $status = read \*STDIN, $buf, BUFFER_SIZE;
+ unless ( defined $status ) {
+ print STDERR "$0: couldn't read message: $!\n";
+ exit EX_TEMPFAIL;
+ } elsif ( !$status ) {
+ last;
+ }
+ $empty = 0 if $buf =~ /\S/;
+ print $fh $buf;
+ };
+ close $fh;
+
+ if ( $empty ) {
+ print STDERR "$0: no message passed on STDIN\n";
+ exit 0;
+ }
+ print STDERR "$0: temp file is '$filename'\n" if $opts{'debug'};
+ return (filename => $filename);
+}
+
=head1 SYNOPSIS
@@ -166,8 +237,6 @@ Usual invocation (from MTA):
-See C<man rt-mailgate> for more.
-
=head1 OPTIONS
=over 3
@@ -178,7 +247,7 @@ Specifies what happens to email sent to this alias. The avaliable
basic actions are: C<correspond>, C<comment>.
-If you've set the RT configuration variable B<$RT::UnsafeEmailCommands>,
+If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>,
C<take> and C<resolve> are also available. You can execute two or more
actions on a single message using a C<-> separated list. RT will execute
the actions in the listed order. For example you can use C<take-comment>,
@@ -259,13 +328,13 @@ there are situations in which you will want to authenticate users
before allowing them to communicate with the system. You can do this
via a plug-in mechanism in the RT configuration.
-You can set the array C<@RT::MailPlugins> to be a list of plugins. The
+You can set the array C<@MailPlugins> to be a list of plugins. The
default plugin, if this is not given, is C<Auth::MailFrom> - that is,
authentication of the person is done based on the C<From> header of the
email. If you have additional filters or authentication mechanisms, you
can list them here and they will be called in order:
- @RT::MailPlugins = (
+ Set( @MailPlugins =>
"Filter::SpamAssassin",
"Auth::LDAP",
# ...
@@ -273,12 +342,12 @@ can list them here and they will be called in order:
See the documentation for any additional plugins you have.
-You may also put Perl subroutines into the C<@RT::MailPlugins> array, if
+You may also put Perl subroutines into the C<@MailPlugins> array, if
they behave as described below.
=head1 WRITING PLUGINS
-What's actually going on in the above is that C<@RT::MailPlugins> is a
+What's actually going on in the above is that C<@MailPlugins> is a
list of Perl modules; RT prepends C<RT::Interface::Email::> to the name,
to form a package name, and then C<use>'s this module. The module is
expected to provide a C<GetCurrentUser> subroutine, which takes a hash of
@@ -319,5 +388,22 @@ the correspondent) or one, which is the normal mode of operation.
Additionally, if C<-1> is returned, then the processing of the plug-ins
stops immediately and the message is ignored.
+=head1 ENVIRONMENT
+
+=over 4
+
+=item EXTENSION
+
+Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
+and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value
+of this variable to message in the C<X-RT-Mail-Extension> field of the message
+header.
+
+See also C<--extension> option. Note that value of the environment variable is
+always added to the message header when it's not empty even if C<--extension>
+option is not provided.
+
+=back 4
+
=cut
diff --git a/rt/bin/rt.in b/rt/bin/rt.in
index 9731acf7d..aa3ac33de 100644
--- a/rt/bin/rt.in
+++ b/rt/bin/rt.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -58,7 +58,19 @@ use Cwd;
use LWP;
use Text::ParseWords;
use HTTP::Request::Common;
+use HTTP::Headers;
use Term::ReadLine;
+use Time::Local; # used in prettyshow
+
+# strong (GSSAPI based) authentication is supported if the server does provide
+# it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed
+# it can be suppressed by setting externalauth=0 (default is undef)
+eval { require GSSAPI };
+my $no_strong_auth = 'missing perl module GSSAPI';
+if ( ! $@ ) {
+ eval {require LWP::Authen::Negotiate};
+ $no_strong_auth = $@ ? 'missing perl module LWP::Authen::Negotiate' : 0;
+}
# We derive configuration information from hardwired defaults, dotfiles,
# and the RT* environment variables (in increasing order of precedence).
@@ -70,18 +82,27 @@ my $HOME = eval{(getpwuid($<))[7]}
|| ".";
my %config = (
(
- debug => 0,
- user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
- passwd => undef,
- server => 'http://localhost/',
- query => undef,
- orderby => undef,
+ debug => 0,
+ user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
+ passwd => undef,
+ server => 'http://localhost/',
+ query => "Status!='resolved' and Status!='rejected'",
+ orderby => 'id',
+ queue => undef,
+# to protect against unlimited searches a better choice would be
+# queue => 'Unknown_Queue',
+# setting externalauth => undef will try GSSAPI auth if the corresponding perl
+# modules are installed, externalauth => 0 is the backward compatible choice
+ externalauth => 0,
),
config_from_file($ENV{RTCONFIG} || ".rtrc"),
config_from_env()
);
my $session = new Session("$HOME/.rt_sessions");
my $REST = "$config{server}/REST/1.0";
+$no_strong_auth = 'switched off by externalauth=0'
+ if defined $config{externalauth};
+
my $prompt = 'rt> ';
@@ -91,11 +112,12 @@ 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_-]|\s+)*)';
-my $label = '[a-zA-Z0-9@_.+-]+';
-my $labels = "(?:$label,)*$label";
-my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
+my $name = '[\w.-]+';
+my $CF_name = '[\sa-z0-9_ :()/-]+';
+my $field = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
+my $label = '[a-zA-Z0-9@_.+-]+';
+my $labels = "(?:$label,)*$label";
+my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
# Our command line looks like this:
#
@@ -119,6 +141,8 @@ my %handlers = (
grant => ["grant", "revoke"],
take => ["take", "steal", "untake"],
quit => ["quit", "exit"],
+ setcommand => ["del", "delete", "give", "res", "resolve",
+ "subject"],
);
my %actions;
@@ -137,16 +161,16 @@ sub handler {
shift @ARGV if ($ARGV[0] eq 'rt'); # ignore a leading 'rt'
if (@ARGV && exists $actions{$ARGV[0]}) {
$action = shift @ARGV;
- $actions{$action}->($action);
+ return $actions{$action}->($action);
}
else {
print STDERR "rt: Unknown command '@ARGV'.\n";
print STDERR "rt: For help, run 'rt help'.\n";
+ return 1;
}
}
-handler();
-exit;
+exit handler();
# Handler functions.
# ------------------
@@ -166,10 +190,12 @@ sub shell {
sub version {
print "rt $VERSION\n";
+ return 0;
}
sub logout {
submit("$REST/logout") if defined $session->cookie;
+ return 0;
}
sub quit {
@@ -179,7 +205,8 @@ sub quit {
my %help;
sub help {
- my ($action, $type) = @_;
+ my ($action, $type, $rv) = @_;
+ $rv = defined $rv ? $rv : 0;
my $key;
# What help topics do we know about?
@@ -228,6 +255,7 @@ sub help {
}
print STDERR $help{$key}, "\n\n";
+ return $rv;
}
# Displays a list of objects that match some specified condition.
@@ -240,6 +268,9 @@ sub list {
$data{orderby} = $config{orderby};
}
my $bad = 0;
+ my $rawprint = 0;
+ my $reverse_sort = 0;
+ my $queue = $config{queue};
while (@ARGV) {
$_ = shift @ARGV;
@@ -255,6 +286,13 @@ sub list {
}
elsif (/^-([isl])$/) {
$data{format} = $1;
+ $rawprint = 1;
+ }
+ elsif (/^-q$/) {
+ $queue = shift @ARGV;
+ }
+ elsif (/^-r$/) {
+ $reverse_sort = 1;
}
elsif (/^-f$/) {
if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
@@ -262,6 +300,8 @@ sub list {
$bad = 1; last;
}
$data{fields} = shift @ARGV;
+ $data{format} = 's' if ! $data{format};
+ $rawprint = 1;
}
elsif (!defined $q && !/^-/) {
$q = $_;
@@ -272,10 +312,35 @@ sub list {
$bad = 1; last;
}
}
+ if ( ! $rawprint and ! exists $data{format} ) {
+ $data{format} = 'l';
+ }
+ if ( $reverse_sort and $data{orderby} =~ /^-/ ) {
+ $data{orderby} =~ s/^-/+/;
+ } elsif ($reverse_sort) {
+ $data{orderby} =~ s/^\+?(.*)/-$1/;
+ }
+
if (!defined $q) {
$q = $config{query};
}
+ $q =~ s/^#//; # get rid of leading hash
+ if ($q =~ /^\d+$/) {
+ # only digits, must be an id, formulate a correct query
+ $q = "id=$q" if $q =~ /^\d+$/;
+ } else {
+ # a string only, take it as an owner or requestor (quoting done later)
+ $q = "(Owner=$q or Requestor like $q) and $config{query}"
+ if $q =~ /^[\w\-]+$/;
+ # always add a query for a specific queue or (comma separated) queues
+ $queue =~ s/,/ or Queue=/g if $queue;
+ $q .= " and (Queue=$queue)" if $queue and $q and $q !~ /Queue\s*=/i
+ and $q !~ /id\s*=/i;
+ }
+ # correctly quote strings in a query
+ $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g;
+
$type ||= "ticket";
unless ($type && defined $q) {
my $item = $type ? "query string" : "object type";
@@ -283,10 +348,17 @@ sub list {
$bad = 1;
}
#return help("list", $type) if $bad;
- return suggest_help("list", $type) if $bad;
+ return suggest_help("list", $type, $bad) if $bad;
+ print "Query:$q\n" if ! $rawprint;
my $r = submit("$REST/search/$type", { query => $q, %data });
- print $r->content;
+ if ( $rawprint ) {
+ print $r->content;
+ } else {
+ my $forms = Form::parse($r->content);
+ prettylist ($forms);
+ }
+ return 0;
}
# Displays selected information about a single object.
@@ -295,10 +367,12 @@ sub show {
my ($type, @objects, %data);
my $slurped = 0;
my $bad = 0;
+ my $rawprint = 0;
+ my $histspec;
while (@ARGV) {
$_ = shift @ARGV;
-
+ s/^#// if /^#\d+/; # get rid of leading hash
if (/^-t$/) {
$bad = 1, last unless defined($type = get_type_argument());
}
@@ -307,6 +381,7 @@ sub show {
}
elsif (/^-([isl])$/) {
$data{format} = $1;
+ $rawprint = 1;
}
elsif (/^-$/ && !$slurped) {
chomp(my @lines = <STDIN>);
@@ -325,9 +400,21 @@ sub show {
$bad = 1; last;
}
$data{fields} = shift @ARGV;
+ # option f requires short raw listing format
+ $data{format} = 's';
+ $rawprint = 1;
+ }
+ elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
+ push @objects, $spc2;
+ $histspec = is_object_spec("ticket/$_/history", $type);
+ }
+ elsif (/^\d+\// and my $spc3 = is_object_spec("ticket/$_", $type)) {
+ push @objects, $spc3;
+ $rawprint = 1 if $_ =~ /\/content$/;
}
elsif (my $spec = is_object_spec($_, $type)) {
push @objects, $spec;
+ $rawprint = 1 if $_ =~ /\/content$/ or $_ !~ /^ticket/;
}
else {
my $datum = /^-/ ? "option" : "argument";
@@ -335,13 +422,17 @@ sub show {
$bad = 1; last;
}
}
+ if ( ! $rawprint ) {
+ push @objects, $histspec if $histspec;
+ $data{format} = 'l' if ! exists $data{format};
+ }
unless (@objects) {
whine "No objects specified.";
$bad = 1;
}
#return help("show", $type) if $bad;
- return suggest_help("show", $type) if $bad;
+ return suggest_help("show", $type, $bad) if $bad;
my $r = submit("$REST/show", { id => \@objects, %data });
my $c = $r->content;
@@ -350,8 +441,17 @@ sub show {
# show ticket/id/attachments/id/content > foo.tar.gz
if ($r->content_type !~ /^text\//) {
chomp($c);
+ $rawprint = 1;
+ }
+ if ( $rawprint ) {
+ print $c;
+ } else {
+ # I do not know how to get more than one form correctly returned
+ $c =~ s!^RT/[\d\.]+ 200 Ok$!--!mg;
+ my $forms = Form::parse($c);
+ prettyshow ($forms);
}
- print $c;
+ return 0;
}
# To create a new object, we ask the server for a form with the defaults
@@ -373,6 +473,7 @@ sub edit {
while (@ARGV) {
$_ = shift @ARGV;
+ s/^#// if /^#\d+/; # get rid of leading hash
if (/^-e$/) { $edit = 1 }
elsif (/^-i$/) { $input = 1 }
@@ -397,7 +498,7 @@ sub edit {
elsif (/^set$/i) {
my $vars = 0;
- while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/) {
+ while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/s) {
my ($key, $op, $val) = ($1, $2, $3);
my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del;
@@ -415,7 +516,7 @@ sub edit {
my $vars = 0;
my $hash = ($_ eq "add") ? \%add : \%del;
- while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/) {
+ while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/s) {
my ($key, $val) = ($1, $2);
vpush($hash, lc $key, $val);
@@ -428,6 +529,9 @@ sub edit {
}
$cl = $vars;
}
+ elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
+ push @objects, $spc2;
+ }
elsif (my $spec = is_object_spec($_, $type)) {
push @objects, $spec;
}
@@ -453,10 +557,10 @@ sub edit {
whine "What type of object do you want to create?";
$bad = 1;
}
- @objects = ("$type/new");
+ @objects = ("$type/new") if defined($type);
}
#return help($action, $type) if $bad;
- return suggest_help($action, $type) if $bad;
+ return suggest_help($action, $type, $bad) 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
@@ -540,7 +644,7 @@ sub edit {
if ($output) {
print $text;
- return;
+ return 0;
}
my $synerr = 0;
@@ -566,11 +670,60 @@ EDIT:
}
else {
print $r->content;
- return;
+ return 0;
}
}
print $r->content;
}
+ return 0;
+}
+
+# handler for special edit commands. A valid edit command is constructed and
+# further work is delegated to the edit handler
+
+sub setcommand {
+ my ($action) = @_;
+ my ($id, $bad, $what);
+ if ( @ARGV ) {
+ $_ = shift @ARGV;
+ $id = $1 if (m|^(?:ticket/)?($idlist)$|);
+ }
+ if ( ! $id ) {
+ $bad = 1;
+ whine "No ticket number specified.";
+ }
+ if ( @ARGV ) {
+ if ($action eq 'subject') {
+ my $subject = '"'.join (" ", @ARGV).'"';
+ @ARGV = ();
+ $what = "subject=$subject";
+ } elsif ($action eq 'give') {
+ my $owner = shift @ARGV;
+ $what = "owner=$owner";
+ }
+ } else {
+ if ( $action eq 'delete' or $action eq 'del' ) {
+ $what = "status=deleted";
+ } elsif ($action eq 'resolve' or $action eq 'res' ) {
+ $what = "status=resolved";
+ } elsif ($action eq 'take' ) {
+ $what = "owner=$config{user}";
+ } elsif ($action eq 'untake') {
+ $what = "owner=Nobody";
+ }
+ }
+ if (@ARGV) {
+ $bad = 1;
+ whine "Extraneous arguments for action $action: @ARGV.";
+ }
+ if ( ! $what ) {
+ $bad = 1;
+ whine "unrecognized action $action.";
+ }
+ return help("edit", undef, $bad) if $bad;
+ @ARGV = ( $id, "set", $what );
+ print "Executing: rt edit @ARGV\n";
+ return edit("edit");
}
# We roll "comment" and "correspond" into the same handler.
@@ -595,7 +748,7 @@ sub comment {
if (/-a/) {
unless (-f $ARGV[0] && -r $ARGV[0]) {
whine "Cannot read attachment: '$ARGV[0]'.";
- return;
+ return 0;
}
push @files, shift @ARGV;
}
@@ -665,7 +818,7 @@ sub comment {
goto NEXT;
}
elsif (!@$o) {
- return;
+ return 0;
}
@files = @{ vsplit($k->{Attachment}) };
@@ -683,6 +836,7 @@ sub comment {
my $r = submit("$REST/ticket/$id/comment", \%data);
print $r->content;
+ return 0;
}
# Merge one ticket into another.
@@ -693,6 +847,7 @@ sub merge {
while (@ARGV) {
$_ = shift @ARGV;
+ s/^#// if /^#\d+/; # get rid of leading hash
if (/^\d+$/) {
push @id, $_;
@@ -709,16 +864,19 @@ sub merge {
$bad = 1;
}
#return help("merge", "ticket") if $bad;
- return suggest_help("merge", "ticket") if $bad;
+ return suggest_help("merge", "ticket", $bad) if $bad;
my $r = submit("$REST/ticket/$id[0]/merge/$id[1]");
print $r->content;
+ return 0;
}
# Link one ticket to another.
sub link {
my ($bad, $del, %data) = (0, 0, ());
+ my $type;
+
my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo
ReferredToBy HasMember MemberOf);
@@ -728,21 +886,26 @@ sub link {
if (/^-d$/) {
$del = 1;
}
+ elsif (/^-t$/) {
+ $bad = 1, last unless defined($type = get_type_argument());
+ }
else {
whine "Unrecognised option: '$_'.";
$bad = 1; last;
}
}
-
+
+ $type = "ticket" unless $type; # default type to tickets
+
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.";
+ whine "Invalid $type ID '$bad' specified.";
$bad = 1;
}
- unless (exists $ltypes{lc $rel}) {
- whine "Invalid link '$rel' specified.";
+ if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
+ whine "Invalid link '$rel' for type $type specified.";
$bad = 1;
}
%data = (id => $from, rel => $rel, to => $to, del => $del);
@@ -752,11 +915,11 @@ sub link {
whine "Too $bad arguments specified.";
$bad = 1;
}
- #return help("link", "ticket") if $bad;
- return suggest_help("link", "ticket") if $bad;
-
- my $r = submit("$REST/ticket/link", \%data);
+ return suggest_help("link", $type, $bad) if $bad;
+
+ my $r = submit("$REST/$type/link", \%data);
print $r->content;
+ return 0;
}
# Take/steal a ticket
@@ -791,10 +954,11 @@ sub take {
whine "Too $bad arguments specified.";
$bad = 1;
}
- return suggest_help("take", "ticket") if $bad;
+ return suggest_help("take", "ticket", $bad) if $bad;
my $r = submit("$REST/ticket/$id/take", \%data);
print $r->content;
+ return 0;
}
# Grant/revoke a user's rights.
@@ -807,6 +971,7 @@ sub grant {
}
$revoke = 1 if $cmd->{action} eq 'revoke';
+ return 0;
}
# Client <-> Server communication.
@@ -820,6 +985,7 @@ sub submit {
my ($uri, $content) = @_;
my ($req, $data);
my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1);
+ my $h = HTTP::Headers->new;
# Did the caller specify any data to send with the request?
$data = [];
@@ -845,9 +1011,22 @@ sub submit {
}
# 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() );
+ my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted';
+ (my $server = $config{server}) =~ s/^.*\/\/([^\/]+)\/?/$1/;
+ if ($config{externalauth}) {
+ $h->authorization_basic($config{user}, $config{passwd} || read_passwd() );
+ print " Password will be sent to $server $how\n",
+ " Press CTRL-C now if you do not want to continue\n"
+ if ! $config{passwd};
+ } elsif ( $no_strong_auth ) {
+ if (!defined $session->cookie) {
+ print " Strong encryption not available, $no_strong_auth\n",
+ " Password will be sent to $server $how\n",
+ " Press CTRL-C now if you do not want to continue\n"
+ if ! $config{passwd};
+ push @$data, ( user => $config{user} );
+ push @$data, ( pass => $config{passwd} || read_passwd() );
+ }
}
# Now, we construct the request.
@@ -858,6 +1037,9 @@ sub submit {
$req = GET($uri);
}
$session->add_cookie_header($req);
+ if ($config{externalauth}) {
+ $req->header(%$h);
+ }
# Then we send the request and parse the response.
DEBUG(3, $req->as_string);
@@ -874,7 +1056,7 @@ sub submit {
$text =~ s/\n*$/\n/ if ($text);
# "RT/3.0.1 401 Credentials required"
- if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) {
+ if ($status !~ m#^RT/\d+(?:\S+) (\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;
@@ -1043,7 +1225,7 @@ sub submit {
sub Form::parse {
my $state = 0;
my @forms = ();
- my @lines = split /\n/, $_[0];
+ my @lines = split /\n/, $_[0] if $_[0];
my ($c, $o, $k, $e) = ("", [], {}, "");
LINE:
@@ -1199,7 +1381,8 @@ sub Form::compose {
sub config_from_env {
my %env;
- foreach my $k ("DEBUG", "USER", "PASSWD", "SERVER", "QUERY", "ORDERBY") {
+ foreach my $k (qw(EXTERNALAUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) {
+
if (exists $ENV{"RT$k"}) {
$env{lc $k} = $ENV{"RT$k"};
}
@@ -1251,7 +1434,7 @@ sub parse_config_file {
chomp;
next if (/^#/ || /^\s*$/);
- if (/^(user|passwd|server|query|orderby)\s+(.*)\s?$/) {
+ if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
$cfg{$1} = $2;
}
else {
@@ -1270,7 +1453,7 @@ sub whine {
my $sub = (caller(1))[3];
$sub =~ s/^main:://;
warn "rt: $sub: @_\n";
- return;
+ return 0;
}
sub read_passwd {
@@ -1331,7 +1514,37 @@ sub vsplit {
# XXX: This should become a real parser, à la Text::ParseWords.
$line =~ s/^\s+//;
$line =~ s/\s+$//;
- push @words, split /\s*,\s*/, $line;
+ my ( $a, $b ) = split /,/, $line, 2;
+
+ while ($a) {
+ no warnings 'uninitialized';
+ if ( $a =~ /^'/ ) {
+ my $s = $a;
+ while ( $a !~ /'$/ || ( $a !~ /(\\\\)+'$/
+ && $a =~ /(\\)+'$/ )) {
+ ( $a, $b ) = split /,/, $b, 2;
+ $s .= ',' . $a;
+ }
+ push @words, $s;
+ }
+ elsif ( $a =~ /^q{/ ) {
+ my $s = $a;
+ while ( $a !~ /}$/ ) {
+ ( $a, $b ) =
+ split /,/, $b, 2;
+ $s .= ',' . $a;
+ }
+ $s =~ s/^q{/'/;
+ $s =~ s/}/'/;
+ push @words, $s;
+ }
+ else {
+ push @words, $a;
+ }
+ ( $a, $b ) = split /,/, $b, 2;
+ }
+
+
}
return \@words;
@@ -1406,14 +1619,130 @@ sub is_object_spec {
$spec =~ s|^(?:$type/)?|$type/| if defined $type;
return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o);
- return;
+ return 0;
}
sub suggest_help {
- my ($action, $type) = @_;
+ my ($action, $type, $rv) = @_;
print STDERR "rt: For help, run 'rt help $action'.\n" if defined $action;
print STDERR "rt: For help, run 'rt help $type'.\n" if defined $type;
+ return $rv;
+}
+
+sub str2time {
+ # simplified procedure for parsing date, avoid loading Date::Parse
+ my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5,
+ Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11);
+ $_ = shift;
+ my ($mon, $day, $hr, $min, $sec, $yr, $monstr);
+ if ( /(\w{3})\s+(\d\d?)\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/ ) {
+ ($monstr, $day, $hr, $min, $sec, $yr) = ($1, $2, $3, $4, $5, $6);
+ $mon = $month{$monstr} if exists $month{$monstr};
+ } elsif ( /(\d{4})-(\d\d)-(\d\d)\s+(\d\d):(\d\d):(\d\d)/ ) {
+ ($yr, $mon, $day, $hr, $min, $sec) = ($1, $2-1, $3, $4, $5, $6);
+ }
+ if ( $yr and defined $mon and $day and defined $hr and defined $sec ) {
+ return timelocal($sec,$min,$hr,$day,$mon,$yr);
+ } else {
+ print "Unknown date format in parsedate: $_\n";
+ return undef;
+ }
+}
+
+sub date_diff {
+ my ($old, $new) = @_;
+ $new = time() if ! $new;
+ $old = str2time($old) if $old !~ /^\d+$/;
+ $new = str2time($new) if $new !~ /^\d+$/;
+ return "???" if ! $old or ! $new;
+
+ my %seconds = (min => 60,
+ hr => 60*60,
+ day => 60*60*24,
+ wk => 60*60*24*7,
+ mth => 60*60*24*30,
+ yr => 60*60*24*365);
+
+ my $diff = $new - $old;
+ my $what = 'sec';
+ my $howmuch = $diff;
+ for ( sort {$seconds{$a} <=> $seconds{$b}} keys %seconds) {
+ last if $diff < $seconds{$_};
+ $what = $_;
+ $howmuch = int($diff/$seconds{$_});
+ }
+ return "$howmuch $what";
+}
+
+sub prettyshow {
+ my $forms = shift;
+ my ($form) = grep { exists $_->[2]->{Queue} } @$forms;
+ my $k = $form->[2];
+ # dates are in local time zone
+ if ( $k ) {
+ print "Date: $k->{Created}\n";
+ print "From: $k->{Requestors}\n";
+ print "Cc: $k->{Cc}\n" if $k->{Cc};
+ print "X-AdminCc: $k->{AdminCc}\n" if $k->{AdminCc};
+ print "X-Queue: $k->{Queue}\n";
+ print "Subject: [rt #$k->{id}] $k->{Subject}\n\n";
+ }
+ # dates in these attributes are in GMT and will be converted
+ foreach my $form (@$forms) {
+ my ($c, $o, $k, $e) = @$form;
+ next if ! $k->{id} or exists $k->{Queue};
+ if ( exists $k->{Created} ) {
+ my ($y,$m,$d,$hh,$mm,$ss) = ($k->{Created} =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/);
+ $m--;
+ my $created = localtime(timegm($ss,$mm,$hh,$d,$m,$y));
+ if ( exists $k->{Description} ) {
+ print "===> $k->{Description} on $created\n";
+ }
+ }
+ print "$k->{Content}\n" if exists $k->{Content} and
+ $k->{Content} !~ /to have no content$/ and
+ $k->{Type} ne 'EmailRecord';
+ print "$k->{Attachments}\n" if exists $k->{Attachments} and
+ $k->{Attachments};
+ }
+}
+
+sub prettylist {
+ my $forms = shift;
+ my $heading = "Ticket Owner Queue Age Told Status Requestor Subject\n";
+ $heading .= '-' x 80 . "\n";
+ my (@open, @me);
+ foreach my $form (@$forms) {
+ my ($c, $o, $k, $e) = @$form;
+ next if ! $k->{id};
+ print $heading if $heading;
+ $heading = '';
+ my $id = $k->{id};
+ $id =~ s!^ticket/!!;
+ my $owner = $k->{Owner} eq 'Nobody' ? '' : $k->{Owner};
+ $owner = substr($owner, 0, 5);
+ my $queue = substr($k->{Queue}, 0, 5);
+ my $subject = substr($k->{Subject}, 0, 30);
+ my $age = date_diff($k->{Created});
+ my $told = $k->{Told} eq 'Not set' ? '' : date_diff($k->{Told});
+ my $status = substr($k->{Status}, 0, 6);
+ my $requestor = substr($k->{Requestors}, 0, 9);
+ my $line = sprintf "%6s %5s %5s %6s %6s %-6s %-9s %-30s\n",
+ $id, $owner, $queue, $age, $told, $status, $requestor, $subject;
+ if ( $k->{Owner} eq 'Nobody' ) {
+ push @open, $line;
+ } elsif ($k->{Owner} eq $config{user} ) {
+ push @me, $line;
+ } else {
+ print $line;
+ }
+ }
+ print "No matches found\n" if $heading;
+ printf "========== my %2d open tickets ==========\n", scalar @me if @me;
+ print @me if @me;
+ printf "========== %2d unowned tickets ==========\n", scalar @open if @open;
+ print @open if @open;
}
__DATA__
@@ -1511,9 +1840,21 @@ Text:
- passwd <passwd> RT user's password.
- query <RT Query> Default RT Query for list action
- orderby <order> Default RT order for list action
+ - queue <queuename> Default RT Queue for list action
+ - externalauth <0|1> Use HTTP Basic authentication
+ explicitely setting externalauth to 0 inhibits also GSSAPI based
+ authentication, if LWP::Authen::Negotiate (and GSSAPI) is installed
Blank and #-commented lines are ignored.
+ Sample configuration file contents:
+
+ server https://rt.somewhere.com/
+ # more than one queue can be given (by adding a query expression)
+ queue helpdesk or queue=support
+ query Status != resolved and Owner=myaccount
+
+
Environment variables:
The following environment variables override any corresponding
@@ -1521,6 +1862,7 @@ Text:
- RTUSER
- RTPASSWD
+ - RTEXTERNALAUTH
- RTSERVER
- RTDEBUG Numeric debug level. (Set to 3 for full logs.)
- RTCONFIG Specifies a name other than ".rtrc" for the
@@ -1552,8 +1894,12 @@ Text:
"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-10".
+ If just a number is given as object specification it will be
+ interpreted as ticket/<number>
+
Examples:
+ 1 # the same as ticket/1
ticket/1
ticket/1/attachments
ticket/1/attachments/3
@@ -1591,6 +1937,22 @@ Text:
- rt help <action> (action-specific details)
- rt help types (a list of possible types)
+ The following actions on tickets are also possible:
+
+ - comment Add comments to a ticket
+ - correspond Add comments to a ticket
+ - merge Merge one ticket into another
+ - link Link one ticket to another
+ - take Take a ticket (steal and untake are possible as well)
+
+ For several edit set subcommands that are frequently used abbreviations
+ have been introduced. These abbreviations are:
+
+ - delete or del delete a ticket (edit set status=deleted)
+ - resolve or res resolve a ticket (edit set status=resolved)
+ - subject change subject of ticket (edit set subject=string)
+ - give give a ticket to somebody (edit set owner=user)
+
--
Title: types
@@ -1629,6 +1991,13 @@ Text:
- merge
- comment
- correspond
+ - take
+ - steal
+ - untake
+ - give
+ - resolve
+ - delete
+ - subject
Attributes:
@@ -1687,6 +2056,83 @@ Text:
--
+Title: subject
+Text:
+
+ Syntax:
+
+ rt subject <id> <new subject text>
+
+ Change the subject of a ticket whose ticket id is given.
+
+--
+
+Title: give
+Text:
+
+ Syntax:
+
+ rt give <id> <accountname>
+
+ Give a ticket whose ticket id is given to another user.
+
+--
+
+Title: steal
+Text:
+
+ rt steal <id>
+
+ Steal a ticket whose ticket id is given, i.e. set the owner to myself.
+
+--
+
+Title: take
+Text:
+
+ Syntax:
+
+ rt take <id>
+
+ Take a ticket whose ticket id is given, i.e. set the owner to myself.
+
+--
+
+Title: untake
+Text:
+
+ Syntax:
+
+ rt untake <id>
+
+ Untake a ticket whose ticket id is given, i.e. set the owner to Nobody.
+
+--
+
+Title: resolve
+Title: res
+Text:
+
+ Syntax:
+
+ rt resolve <id>
+
+ Resolves a ticket whose ticket id is given.
+
+--
+
+Title: delete
+Title: del
+Text:
+
+ Syntax:
+
+ rt delete <id>
+
+ Deletes a ticket whose ticket id is given.
+
+--
+
Title: logout
Text:
@@ -1725,24 +2171,30 @@ Text:
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.
+ -i Numeric IDs only. (Useful for |rt edit -; see examples.)
+ -s Short description.
+ -l Longer description.
+ -f <field[s] Display only the fields listed and the ticket id
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".)
+ -o +/-<field> Orders the returned list by the specified field.
+ -r reversed order (useful if a default was given)
+ -q queue[s] restricts the query to the queue[s] given
+ multiple queues are separated by comma
+ -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 "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]%'"
+ rt ls -q systems
+ rt ls -f owner,subject
--
@@ -1760,16 +2212,28 @@ Text:
that refers to the links for tickets 1-3). Consult "rt help <type>"
and "rt help objects" for further details.
+ If only a number is given it will be interpreted as the objects
+ ticket/number and ticket/number/history
+
This command writes a set of forms representing the requested object
data to STDOUT.
Options:
+ The following options control how much information is displayed
+ about each matching object:
+
+ Without any formatting options prettyprinted output is generated.
+ Giving any of the two options below reverts to raw output.
+ -s Short description (history and attachments only).
+ -l Longer description (history and attachments only).
+
+ In addition,
- 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.
- -v Verbose display
+
Examples:
rt show -t ticket -f id,subject,status 1-3
@@ -1777,8 +2241,9 @@ Text:
rt show ticket/3/attachments/29/content
rt show ticket/1-3/links
rt show ticket/3/history
- rt show -v ticket/3/history
+ rt show -l ticket/3/history
rt show -t user 2
+ rt show 2
--
@@ -1795,6 +2260,8 @@ Text:
Edits information corresponding to the specified objects.
+ A purely numeric object id nnn is translated into ticket/nnn
+
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
@@ -1834,7 +2301,7 @@ Text:
rt create -t ticket
# Non-interactive.
- rt edit ticket/1-3 add cc=foo@example.com set priority=3
+ rt edit ticket/1-3 add cc=foo@example.com set priority=3 due=tomorrow
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
@@ -1930,6 +2397,35 @@ Text:
(XXX: I'm going to have to write it, aren't I?)
+ Until it exists here a short description of important constructs:
+
+ The two simple forms of query expressions are the constructs
+ Attribute like Value and
+ Attribute = Value or Attribute != Value
+
+ Whether attributes can be matched using like or using = is built into RT.
+ The attributes id, Queue, Owner Priority and Status require the = or !=
+ tests.
+
+ If Value is a string it must be quoted and may contain the wildcard
+ character %. If the string does not contain white space, the quoting
+ may however be omitted, it will be added automatically when parsing
+ the input.
+
+ Simple query expressions can be combined using and, or and parentheses
+ can be used to group expressions.
+
+ As a special case a standalone string (which would not form a correct
+ query) is transformed into (Owner='string' or Requestor like 'string%')
+ and added to the default query, i.e. the query is narrowed down.
+
+ If no Queue=name clause is contained in the query, a default clause
+ Queue=$config{queue} is added.
+
+ Examples:
+ Status!='resolved' and Status!='rejected'
+ (Owner='myaccount' or Requestor like 'myaccount%') and Status!='resolved'
+
--
Title: form
@@ -1984,10 +2480,43 @@ 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.
+ some useful examples
+
+ All the following list requests will be restricted to the default queue.
+ That can be changed by adding the option -q queuename
+
+ List all tickets that are not rejected/resolved
+ rt ls
+ List all tickets that are new and do not have an owner
+ rt ls "status=new and owner=nobody"
+ List all tickets which I have sent or of which I am the owner
+ rt ls myaccount
+ List all attributes for the ticket 6977 (ls -l instead of ls)
+ rt ls -l 6977
+ Show the content of ticket 6977
+ rt show 6977
+ Show all attributes in the ticket and in the history of the ticket
+ rt show -l 6977
+ Comment a ticket (mail is sent to all queue watchers, i.e. AdminCc's)
+ rt comment 6977
+ This will open an editor and lets you add text (attribute Text:)
+ Other attributes may be changed as well, but usually don't do that.
+ Correspond a ticket (like comment, but mail is also sent to requestors)
+ rt correspond 6977
+ Edit a ticket (generic change, interactive using the editor)
+ rt edit 6977
+ Change the owner of a ticket non interactively
+ rt edit 6977 set owner=myaccount
+ or
+ rt give 6977 account
+ or
+ rt take 6977
+ Change the status of a ticket
+ rt edit 6977 set status=resolved
+ or
+ rt resolve 6977
+ Change the status of all tickets I own to resolved !!!
+ rt ls -i owner=myaccount | rt edit - set status=resolved
--
diff --git a/rt/bin/standalone_httpd b/rt/bin/standalone_httpd
index 1057ce0ea..241af8114 100755
--- a/rt/bin/standalone_httpd
+++ b/rt/bin/standalone_httpd
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -49,19 +49,138 @@
use warnings;
use strict;
+# fix lib paths, some may be relative
BEGIN {
- use lib( "/opt/rt3/local/lib", "/opt/rt3/lib");
- use RT;
- RT::LoadConfig();
- if ($RT::DevelMode) { require Module::Refresh; }
+ require File::Spec;
+ my @libs = ("lib", "local/lib");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
}
-RT::Init();
+use RT;
+RT::LoadConfig();
+RT->InitLogging();
+if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
+
+RT::CheckPerlRequirements();
+RT->InitPluginPaths();
+
+my $explicit_port = shift @ARGV;
+my $port = $explicit_port || RT->Config->Get('WebPort') || '8080';
+
+
+require RT::Handle;
+my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
+
+unless ( $integrity ) {
+ print STDERR <<EOF;
+
+RT couldn't connect to the database where tickets are stored.
+If this is a new installation of RT, you should visit the URL below
+to configure RT and initialize your database.
+
+If this is an existing RT installation, this may indicate a database
+connectivity problem.
+
+The error RT got back when trying to connect to your database was:
+
+$msg
+
+EOF
+
+ require RT::Installer;
+ # don't enter install mode if the file exists but is unwritable
+ if (-e RT::Installer->ConfigFile && !-w _) {
+ die 'Since your configuration exists ('
+ . RT::Installer->ConfigFile
+ . ") but is not writable, I'm refusing to do anything.\n";
+ }
-my $port = shift @ARGV || $RT::WebPort || '8080';
-use RT::Interface::Web::Standalone;
+ RT->Config->Set( 'LexiconLanguages' => '*' );
+ RT::I18N->Init;
+
+ RT->InstallMode(1);
+} else {
+ RT->ConnectToDatabase();
+ RT->InitSystemObjects();
+ RT->InitClasses();
+ RT->InitPlugins();
+ RT->Config->PostLoadCheck();
+
+ my ($status, $msg) = RT::Handle->CheckCompatibility(
+ $RT::Handle->dbh, 'post'
+ );
+ unless ( $status ) {
+ print STDERR $msg, "\n\n";
+ exit -1;
+ }
+}
+
+require RT::Interface::Web::Standalone;
my $server = RT::Interface::Web::Standalone->new;
-$server->port($port);
-$server->run();
+run_server($port);
+exit 0;
+sub run_server {
+ my $port = shift;
+ $server->port($port);
+ eval { $server->run() };
+ if ( my $err = $@ ) {
+ handle_startup_error($err);
+ }
+}
+
+sub handle_startup_error {
+ my $err = shift;
+ if ( $err =~ /bind: Permission denied/ ) {
+ handle_bind_error();
+ } else {
+ die
+ "Something went wrong while trying to run RT's standalone web server:\n\t"
+ . $err;
+ }
+}
+
+
+sub handle_bind_error {
+
+ print STDERR <<EOF;
+WARNING: RT couldn't start up a web server on port @{[$port]}.
+This is often the case if you're running @{[$0]} as
+someone other than your system's "root" user.
+EOF
+
+ if ($explicit_port) {
+ print STDERR
+ "Please check your system configuration or choose another port\n\n";
+ } else {
+ print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n";
+ if ( !$integrity ) {
+ print STDERR <<EOF;
+You can use this server to configure and explore RT. While configuring
+RT, you'll have a chance to set a permanent port and URL for your
+server.
+
+EOF
+ }
+ run_server( 8000 + int( rand(1024) ) );
+ }
+}
diff --git a/rt/bin/standalone_httpd.in b/rt/bin/standalone_httpd.in
index 8aebdb867..b87a33206 100755
--- a/rt/bin/standalone_httpd.in
+++ b/rt/bin/standalone_httpd.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -49,19 +49,138 @@
use warnings;
use strict;
+# fix lib paths, some may be relative
BEGIN {
- use lib( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@");
- use RT;
- RT::LoadConfig();
- if ($RT::DevelMode) { require Module::Refresh; }
+ require File::Spec;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
}
-RT::Init();
+use RT;
+RT::LoadConfig();
+RT->InitLogging();
+if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
+
+RT::CheckPerlRequirements();
+RT->InitPluginPaths();
+
+my $explicit_port = shift @ARGV;
+my $port = $explicit_port || RT->Config->Get('WebPort') || '8080';
+
+
+require RT::Handle;
+my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
+
+unless ( $integrity ) {
+ print STDERR <<EOF;
+
+RT couldn't connect to the database where tickets are stored.
+If this is a new installation of RT, you should visit the URL below
+to configure RT and initialize your database.
+
+If this is an existing RT installation, this may indicate a database
+connectivity problem.
+
+The error RT got back when trying to connect to your database was:
+
+$msg
+
+EOF
+
+ require RT::Installer;
+ # don't enter install mode if the file exists but is unwritable
+ if (-e RT::Installer->ConfigFile && !-w _) {
+ die 'Since your configuration exists ('
+ . RT::Installer->ConfigFile
+ . ") but is not writable, I'm refusing to do anything.\n";
+ }
-my $port = shift @ARGV || $RT::WebPort || '8080';
-use RT::Interface::Web::Standalone;
+ RT->Config->Set( 'LexiconLanguages' => '*' );
+ RT::I18N->Init;
+
+ RT->InstallMode(1);
+} else {
+ RT->ConnectToDatabase();
+ RT->InitSystemObjects();
+ RT->InitClasses();
+ RT->InitPlugins();
+ RT->Config->PostLoadCheck();
+
+ my ($status, $msg) = RT::Handle->CheckCompatibility(
+ $RT::Handle->dbh, 'post'
+ );
+ unless ( $status ) {
+ print STDERR $msg, "\n\n";
+ exit -1;
+ }
+}
+
+require RT::Interface::Web::Standalone;
my $server = RT::Interface::Web::Standalone->new;
-$server->port($port);
-$server->run();
+run_server($port);
+exit 0;
+sub run_server {
+ my $port = shift;
+ $server->port($port);
+ eval { $server->run() };
+ if ( my $err = $@ ) {
+ handle_startup_error($err);
+ }
+}
+
+sub handle_startup_error {
+ my $err = shift;
+ if ( $err =~ /bind: Permission denied/ ) {
+ handle_bind_error();
+ } else {
+ die
+ "Something went wrong while trying to run RT's standalone web server:\n\t"
+ . $err;
+ }
+}
+
+
+sub handle_bind_error {
+
+ print STDERR <<EOF;
+WARNING: RT couldn't start up a web server on port @{[$port]}.
+This is often the case if you're running @{[$0]} as
+someone other than your system's "root" user.
+EOF
+
+ if ($explicit_port) {
+ print STDERR
+ "Please check your system configuration or choose another port\n\n";
+ } else {
+ print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n";
+ if ( !$integrity ) {
+ print STDERR <<EOF;
+You can use this server to configure and explore RT. While configuring
+RT, you'll have a chance to set a permanent port and URL for your
+server.
+
+EOF
+ }
+ run_server( 8000 + int( rand(1024) ) );
+ }
+}
diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl
index 02eb84640..cb428ad2c 100755
--- a/rt/bin/webmux.pl
+++ b/rt/bin/webmux.pl
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -64,7 +64,30 @@ BEGIN {
}
-use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("lib", "local/lib");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
+}
use RT;
package RT::Mason;
@@ -74,21 +97,35 @@ use vars qw($Nobody $SystemUser $Handler $r);
#This drags in RT's config.pm
BEGIN {
RT::LoadConfig();
- if ($RT::DevelMode) { require Module::Refresh; }
+ if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
+ RT->InitPluginPaths();
}
-
{
+ require RT::Handle;
+ my $dsn = RT::Handle->DSN;
+ my $user = RT->Config->Get('DatabaseUser');
+ my $pass = RT->Config->Get('DatabasePassword');
+
+ my $dbh = DBI->connect(
+ $dsn, $user, $pass,
+ { RaiseError => 0, PrintError => 0 },
+ );
+ if ( $dbh ) {
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'post' );
+ die $msg unless $status;
+ }
+}
+{
package HTML::Mason::Commands;
use vars qw(%session);
}
use RT::Interface::Web;
use RT::Interface::Web::Handler;
-$Handler = RT::Interface::Web::Handler->new(@RT::MasonParameters);
-if ($ENV{'MOD_PERL'} && !$RT::DevelMode) {
+if ($ENV{'MOD_PERL'} && !RT->Config->Get('DevelMode')) {
# Under static_source, we need to purge the component cache
# each time we restart, so newer components may be reloaded.
#
@@ -116,10 +153,14 @@ sub handler {
#$r->content_type !~ m!(^text/|\bxml\b)!i or return -1;
# }
- Module::Refresh->refresh if $RT::DevelMode;
+ Module::Refresh->refresh if RT->Config->Get('DevelMode');
RT::Init();
+ $Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+ );
+
my %session;
my $status;
eval { $status = $Handler->handle_request($r) };
diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in
index b21d02673..7e61b2775 100644
--- a/rt/bin/webmux.pl.in
+++ b/rt/bin/webmux.pl.in
@@ -2,8 +2,8 @@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -64,7 +64,30 @@ BEGIN {
}
-use lib ( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@" );
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
+}
use RT;
package RT::Mason;
@@ -74,21 +97,35 @@ use vars qw($Nobody $SystemUser $Handler $r);
#This drags in RT's config.pm
BEGIN {
RT::LoadConfig();
- if ($RT::DevelMode) { require Module::Refresh; }
+ if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
+ RT->InitPluginPaths();
}
-
{
+ require RT::Handle;
+ my $dsn = RT::Handle->DSN;
+ my $user = RT->Config->Get('DatabaseUser');
+ my $pass = RT->Config->Get('DatabasePassword');
+
+ my $dbh = DBI->connect(
+ $dsn, $user, $pass,
+ { RaiseError => 0, PrintError => 0 },
+ );
+ if ( $dbh ) {
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'post' );
+ die $msg unless $status;
+ }
+}
+{
package HTML::Mason::Commands;
use vars qw(%session);
}
use RT::Interface::Web;
use RT::Interface::Web::Handler;
-$Handler = RT::Interface::Web::Handler->new(@RT::MasonParameters);
-if ($ENV{'MOD_PERL'} && !$RT::DevelMode) {
+if ($ENV{'MOD_PERL'} && !RT->Config->Get('DevelMode')) {
# Under static_source, we need to purge the component cache
# each time we restart, so newer components may be reloaded.
#
@@ -116,10 +153,14 @@ sub handler {
#$r->content_type !~ m!(^text/|\bxml\b)!i or return -1;
# }
- Module::Refresh->refresh if $RT::DevelMode;
+ Module::Refresh->refresh if RT->Config->Get('DevelMode');
RT::Init();
+ $Handler ||= RT::Interface::Web::Handler->new(
+ RT->Config->Get('MasonParameters')
+ );
+
my %session;
my $status;
eval { $status = $Handler->handle_request($r) };
generated by cgit v1.2.1 (git 2.18.0) at 2024-11-16 13:23:38 +0000