X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Fbin%2Frt;h=1757d08c0d6cf83413263b6c4d3a07885d8a5991;hp=32f459a7e7c785b99db05a0084a262256c7f40d9;hb=187086c479a09629b7d180eec513fb7657f4e291;hpb=a6fe07e49e3fc12169e801b1ed6874c3a5bd8500 diff --git a/rt/bin/rt b/rt/bin/rt index 32f459a7e..1757d08c0 100755 --- a/rt/bin/rt +++ b/rt/bin/rt @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -50,6 +50,7 @@ # Abhijit Menon-Sen use strict; +use warnings; if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) { require Pod::Usage; @@ -67,16 +68,7 @@ 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; -} +use File::Temp; # We derive configuration information from hardwired defaults, dotfiles, # and the RT* environment variables (in increasing order of precedence). @@ -97,18 +89,16 @@ my %config = ( 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, + auth => "rt", ), config_from_file($ENV{RTCONFIG} || ".rtrc"), config_from_env() ); + +$config{auth} = "basic" if delete $config{externalauth}; + my $session = Session->new("$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> '; @@ -119,9 +109,9 @@ sub DEBUG { warn @_ if $config{debug} >= shift } # (XXX: Ask Autrijus how i18n changes these definitions.) my $name = '[\w.-]+'; -my $CF_name = '[\sa-z0-9_ :()/-]+'; +my $CF_name = '[^,]+?'; my $field = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})'; -my $label = '[a-zA-Z0-9@_.+-]+'; +my $label = '[^,\\/]+'; my $labels = "(?:$label,)*$label"; my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+'; @@ -320,6 +310,7 @@ sub list { } if ( ! $rawprint and ! exists $data{format} ) { $data{format} = 'l'; + $data{fields} = 'subject,status,queue,created,told,owner,requestors'; } if ( $reverse_sort and $data{orderby} =~ /^-/ ) { $data{orderby} =~ s/^-/+/; @@ -327,32 +318,53 @@ sub list { $data{orderby} =~ s/^\+?(.*)/-$1/; } - if (!defined $q) { - $q = $config{query}; + $type ||= "ticket"; + + if (!defined $q ) { + if ( $type eq 'ticket' ) { + $q = $config{query}; + } + else { + $q = ''; + } } - - $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; + + if ( $type ne 'ticket' ) { + $rawprint = 1; } - # correctly quote strings in a query - $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g; - $type ||= "ticket"; - unless ($type && defined $q) { + unless (defined $q) { my $item = $type ? "query string" : "object type"; whine "No $item specified."; $bad = 1; } + + $q =~ s/^#//; # get rid of leading hash + if ( $type eq 'ticket' ) { + 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; + } + #return help("list", $type) if $bad; return suggest_help("list", $type, $bad) if $bad; @@ -420,7 +432,7 @@ sub show { } elsif (my $spec = is_object_spec($_, $type)) { push @objects, $spec; - $rawprint = 1 if $_ =~ /\/content$/ or $_ !~ /^ticket/; + $rawprint = 1 if $_ =~ /\/content$/ or $_ =~ /\/links/ or $_ !~ /^ticket/; } else { my $datum = /^-/ ? "option" : "argument"; @@ -470,7 +482,7 @@ sub show { sub edit { my ($action) = @_; my (%data, $type, @objects); - my ($cl, $text, $edit, $input, $output); + my ($cl, $text, $edit, $input, $output, $content_type); use vars qw(%set %add %del); %set = %add = %del = (); @@ -484,6 +496,7 @@ sub edit { if (/^-e$/) { $edit = 1 } elsif (/^-i$/) { $input = 1 } elsif (/^-o$/) { $output = 1 } + elsif (/^-ct$/) { $content_type = shift @ARGV } elsif (/^-t$/) { $bad = 1, last unless defined($type = get_type_argument()); } @@ -653,24 +666,54 @@ sub edit { return 0; } + my @files; + @files = @{ vsplit($set{'attachment'}) } if exists $set{'attachment'}; + my $synerr = 0; EDIT: # We'll let the user edit the form before sending it to the server, # unless we have enough information to submit it non-interactively. + if ( $type && $type eq 'ticket' && $text !~ /^Content-Type:/m ) { + $text .= "Content-Type: $content_type\n" + if $content_type and $content_type ne "text/plain"; + } + if ($edit || (!$input && !$cl)) { - my $newtext = vi($text); + my ($newtext) = vi_form_while( + $text, + sub { + my ($text, $form) = @_; + return 1 unless exists $form->[2]{'Attachment'}; + + foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) { + return (0, "File '$f' doesn't exist") unless -f $f; + } + @files = @{ vsplit($form->[2]{'Attachment'}) }; + return 1; + }, + ); + return $newtext unless $newtext; # We won't resubmit a bad form unless it was changed. $text = ($synerr && $newtext eq $text) ? undef : $newtext; } + delete @data{ grep /^attachment_\d+$/, keys %data }; + my $i = 1; + foreach my $file (@files) { + $data{"attachment_$i"} = bless([ $file ], "Attachment"); + $i++; + } + if ($text) { my $r = submit("$REST/edit", {content => $text, %data}); if ($r->code == 409) { # If we submitted a bad form, we'll give the user a chance # to correct it and resubmit. if ($edit || (!$input && !$cl)) { - $text = $r->content; + my $content = $r->content . "\n"; + $content =~ s/^(?!#)/# /mg; + $text = $content . $text; $synerr = 1; goto EDIT; } @@ -736,8 +779,9 @@ sub setcommand { sub comment { my ($action) = @_; - my (%data, $id, @files, @bcc, @cc, $msg, $wtime, $edit); + my (%data, $id, @files, @bcc, @cc, $msg, $content_type, $wtime, $edit); my $bad = 0; + my $status = ''; while (@ARGV) { $_ = shift @ARGV; @@ -745,7 +789,7 @@ sub comment { if (/^-e$/) { $edit = 1; } - elsif (/^-[abcmw]$/) { + elsif (/^-(?:[abcmws]|ct)$/) { unless (@ARGV) { whine "No argument specified with $_."; $bad = 1; last; @@ -758,6 +802,12 @@ sub comment { } push @files, shift @ARGV; } + elsif (/-ct/) { + $content_type = shift @ARGV; + } + elsif (/-s/) { + $status = shift @ARGV; + } elsif (/-([bc])/) { my $a = $_ eq "-b" ? \@bcc : \@cc; @$a = split /\s*,\s*/, shift @ARGV; @@ -769,7 +819,6 @@ sub comment { while () { $msg .= $_ } } } - elsif (/-w/) { $wtime = shift @ARGV } } elsif (!$id && m|^(?:ticket/)?($idlist)$|) { @@ -791,7 +840,7 @@ sub comment { my $form = [ "", - [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Text" ], + [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Content-Type", "Text" ], { Ticket => $id, Action => $action, @@ -799,38 +848,31 @@ sub comment { Bcc => [ @bcc ], Attachment => [ @files ], TimeWorked => $wtime || '', + 'Content-Type' => $content_type || 'text/plain', Text => $msg || '', - Status => '' + Status => $status } ]; + if ($status ne '') { + push(@{$form->[1]}, "Status"); + } my $text = Form::compose([ $form ]); if ($edit || !$msg) { - my $error = 0; - my ($c, $o, $k, $e); - - do { - my $ntext = vi($text); - return if ($error && $ntext eq $text); - $text = $ntext; - $form = Form::parse($text); - $error = 0; - - ($c, $o, $k, $e) = @{ $form->[0] }; - if ($e) { - $error = 1; - $c = "# Syntax error."; - goto NEXT; - } - elsif (!@$o) { - return 0; - } - @files = @{ vsplit($k->{Attachment}) }; - - NEXT: - $text = Form::compose([[$c, $o, $k, $e]]); - } while ($error); + my ($tmp) = vi_form_while( + $text, + sub { + my ($text, $form) = @_; + foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) { + return (0, "File '$f' doesn't exist") unless -f $f; + } + @files = @{ vsplit($form->[2]{'Attachment'}) }; + return 1; + }, + ); + return $tmp unless $tmp; + $text = $tmp; } my $i = 1; @@ -967,12 +1009,8 @@ sub take { sub grant { my ($cmd) = @_; - my $revoke = 0; - while (@ARGV) { - } - - $revoke = 1 if $cmd->{action} eq 'revoke'; - return 0; + whine "$cmd is unimplemented."; + return 1; } # Client <-> Server communication. @@ -1013,21 +1051,24 @@ sub submit { # Should we send authentication information to start a new session? my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted'; - (my $server = $config{server}) =~ s/^.*\/\/([^\/]+)\/?/$1/; - if ($config{externalauth}) { + my($server) = $config{server} =~ m{^.*//([^/]+)}; + + if ($config{auth} eq "gssapi") { + die "GSSAPI support not available; failed to load perl module GSSAPI:\n$@\n" + unless eval { require GSSAPI; 1 }; + die "GSSAPI support not available; failed to load perl module LWP::Authen::Negotiate:\n$@\n" + unless eval { require LWP::Authen::Negotiate; 1 }; + } elsif ($config{auth} eq "basic") { + print " Password will be sent to $server $how\n", + " Press CTRL-C now if you do not want to continue\n" + if ! $config{passwd}; $h->authorization_basic($config{user}, $config{passwd} || read_passwd() ); + } elsif ( !defined $session->cookie ) { 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() ); - } + push @$data, ( user => $config{user} ); + push @$data, ( pass => $config{passwd} || read_passwd() ); } # Now, we construct the request. @@ -1038,9 +1079,7 @@ sub submit { $req = GET($uri); } $session->add_cookie_header($req); - if ($config{externalauth}) { - $req->header(%$h); - } + $req->header(%$h) if %$h; # Then we send the request and parse the response. DEBUG(3, $req->as_string); @@ -1058,7 +1097,7 @@ sub submit { # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { - warn "rt: Malformed RT response from $config{server}.\n"; + warn "rt: Malformed RT response from $server.\n"; warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3; exit -1; } @@ -1378,7 +1417,7 @@ sub Form::compose { sub config_from_env { my %env; - foreach my $k (qw(EXTERNALAUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) { + foreach my $k (qw(EXTERNALAUTH AUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) { if (exists $ENV{"RT$k"}) { $env{lc $k} = $ENV{"RT$k"}; @@ -1432,7 +1471,7 @@ sub parse_config_file { chomp; next if (/^#/ || /^\s*$/); - if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) { + if (/^(externalauth|auth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) { $cfg{$1} = $2; } else { @@ -1468,25 +1507,59 @@ sub read_passwd { return $passwd; } +sub vi_form_while { + my $text = shift; + my $cb = shift; + + my $error = 0; + my ($c, $o, $k, $e); + do { + my $ntext = vi($text); + return undef if ($error && $ntext eq $text); + + $text = $ntext; + + my $form = Form::parse($text); + $error = 0; + ($c, $o, $k, $e) = @{ $form->[0] }; + if ( $e ) { + $error = 1; + $c = "# Syntax error."; + goto NEXT; + } + elsif (!@$o) { + return 0; + } + + my ($status, $msg) = $cb->( $text, [$c, $o, $k, $e] ); + unless ( $status ) { + $error = 1; + $c = "# $msg"; + } + + NEXT: + $text = Form::compose([[$c, $o, $k, $e]]); + } while ($error); + + return $text; +} + sub vi { my ($text) = @_; - my $file = "/tmp/rt.form.$$"; my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi"; local $/ = undef; - open( my $handle, '>', $file ) or die "$file: $!\n"; + my $handle = File::Temp->new; print $handle $text; close($handle); - system($editor, $file) && die "Couldn't run $editor.\n"; + system($editor, $handle->filename) && die "Couldn't run $editor.\n"; - open( $handle, '<', $file ) or die "$file: $!\n"; + open( $handle, '<', $handle->filename ) or die "$handle: $!\n"; $text = <$handle>; close($handle); - unlink($file); - return $text; } @@ -1507,49 +1580,56 @@ sub vpush { } } +# WARNING: this code is duplicated in lib/RT/Interface/REST.pm +# If you change one, change both functions at once # "Normalise" a hash key that's known to be multi-valued. sub vsplit { - my ($val) = @_; - my ($word, @words); - my @values = ref $val eq 'ARRAY' ? @$val : $val; - - foreach my $line (map {split /\n/} @values) { - # XXX: This should become a real parser, à la Text::ParseWords. - $line =~ s/^\s+//; - $line =~ s/\s+$//; - my ( $a, $b ) = split /\s*,\s*/, $line, 2; - - while ($a) { - no warnings 'uninitialized'; - if ( $a =~ /^'/ ) { - my $s = $a; - while ( $a !~ /'$/ || ( $a !~ /(\\\\)+'$/ - && $a =~ /(\\)+'$/ )) { - ( $a, $b ) = split /\s*,\s*/, $b, 2; - $s .= ',' . $a; - } - push @words, $s; + my ($val, $strip) = @_; + my @words; + my @values = map {split /\n/} (ref $val eq 'ARRAY' ? @$val : $val); + + foreach my $line (@values) { + while ($line =~ /\S/) { + $line =~ s/^ + \s* # Trim leading whitespace + (?: + (") # Quoted string + ((?>[^\\"]*(?:\\.[^\\"]*)*))" + | + (') # Single-quoted string + ((?>[^\\']*(?:\\.[^\\']*)*))' + | + q\{(.*?)\} # A perl-ish q{} string; this does + # no paren balancing, however, and + # only exists for back-compat + | + (.*?) # Anything else, until the next comma + ) + \s* # Trim trailing whitespace + (?: + \Z # Finish at end-of-line + | + , # Or a comma + ) + //xs or last; # There should be no way this match + # fails, but add a failsafe to + # prevent infinite-looping if it + # somehow does. + my ($quote, $quoted) = ($1 ? ($1, $2) : $3 ? ($3, $4) : ('', $5 || $6)); + # Only unquote the quote character, or the backslash -- and + # only if we were originally quoted.. + if ($5) { + $quoted =~ s/([\\'])/\\$1/g; + $quote = "'"; } - elsif ( $a =~ /^q{/ ) { - my $s = $a; - while ( $a !~ /}$/ ) { - ( $a, $b ) = - split /\s*,\s*/, $b, 2; - $s .= ',' . $a; - } - $s =~ s/^q{/'/; - $s =~ s/}/'/; - push @words, $s; - } - else { - push @words, $a; + if ($strip) { + $quoted =~ s/\\([\\$quote])/$1/g if $quote; + push @words, $quoted; + } else { + push @words, "$quote$quoted$quote"; } - ( $a, $b ) = split /\s*,\s*/, $b, 2; } - - } - return \@words; } @@ -1836,15 +1916,17 @@ Text: The following directives may occur, one per line: - - server URL to RT server. - - user RT username. - - passwd RT user's password. - - query Default RT Query for list action - - orderby Default RT order for list action - - queue 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 + - server URL to RT server. + - user RT username. + - passwd RT user's password. + - query Default RT Query for list action + - orderby Default RT order for list action + - queue Default RT Queue for list action + - auth Method to authenticate via; "basic" + means HTTP Basic authentication, "gssapi" means + Kerberos credentials, if your RT is configured + with $WebRemoteUserAuth. For backwards + compatibility, "externalauth 1" means "auth basic" Blank and #-commented lines are ignored. @@ -1863,7 +1945,7 @@ Text: - RTUSER - RTPASSWD - - RTEXTERNALAUTH + - RTAUTH - RTSERVER - RTDEBUG Numeric debug level. (Set to 3 for full logs.) - RTCONFIG Specifies a name other than ".rtrc" for the @@ -1909,8 +1991,6 @@ Text: ticket/1-3,5-7/history user/ams - user/ams/rights - user/ams,rai,1/rights For more information: @@ -2028,20 +2108,6 @@ Text: - edit - create - In addition, the following type-specific actions exist: - - - grant - - revoke - - Attributes: - - The following attributes can be used with "rt show" or "rt edit" - to retrieve or edit other information associated with users and - groups: - - rights Global rights granted to this user. - rights/ Queue rights for this user. - -- Title: queue @@ -2159,13 +2225,14 @@ Text: Displays a list of objects matching the specified conditions. ("ls", "list", and "search" are synonyms.) - Conditions are expressed in the SQL-like syntax used internally by - RT. (For more information, see "rt help query".) The query string - must be supplied as one argument. + The query string must be supplied as one argument. - (Right now, the server doesn't support listing anything but tickets. - Other types will be supported in future; this client will be able to - take advantage of that support without any changes.) + if on tickets, query is in the SQL-like syntax used internally by + RT. (For more information, see "rt help query".), otherwise, query + is plain string with format "FIELD OP VALUE", e.g. "Name = General". + + if query string is absent, we limit to privileged ones on users and + user defined ones on groups automatically. Options: @@ -2196,6 +2263,9 @@ Text: rt ls -t ticket "Subject like '[PATCH]%'" rt ls -q systems rt ls -f owner,subject + rt ls -t queue 'Name = General' + rt ls -t user 'EmailAddress like foo@bar.com' + rt ls -t group 'Name like foo' -- @@ -2294,12 +2364,14 @@ Text: -S var=val Submits the specified variable with the request. -t type Specifies object type. + -ct content-type Specifies content type of message(tickets only). Examples: # Interactive (starts $EDITOR with a form). rt edit ticket/3 rt create -t ticket + rt create -t ticket -ct text/html # Non-interactive. rt edit ticket/1-3 add cc=foo@example.com set priority=3 due=tomorrow @@ -2331,10 +2403,13 @@ Text: Options: -m Specify comment text. + -ct Specify content-type of comment text. -a Attach a file to the comment. (May be used more than once to attach multiple files.) -c A comma-separated list of Cc addresses. -b A comma-separated list of Bcc addresses. + -s Set a new status for the ticket (default will + leave the status unchanged) -w