RT 3.8.15
authorIvan Kohler <ivan@freeside.biz>
Mon, 12 Nov 2012 07:29:41 +0000 (23:29 -0800)
committerIvan Kohler <ivan@freeside.biz>
Mon, 12 Nov 2012 07:29:41 +0000 (23:29 -0800)
21 files changed:
FS/FS/AccessRight.pm
FS/FS/access_right.pm
rt/configure
rt/configure.ac
rt/lib/RT/Action/SendEmail.pm
rt/lib/RT/Attachment_Overlay.pm
rt/lib/RT/Crypt/GnuPG.pm
rt/lib/RT/Interface/Email.pm
rt/lib/RT/Interface/Email/Auth/GnuPG.pm
rt/lib/RT/Interface/Web.pm
rt/lib/RT/Queue_Overlay.pm
rt/lib/RT/Template_Overlay.pm
rt/lib/RT/User_Overlay.pm
rt/share/html/Admin/Queues/Modify.html
rt/share/html/Admin/Users/GnuPG.html
rt/share/html/Elements/CSRF
rt/share/html/Elements/GnuPG/SignEncryptWidget
rt/share/html/Elements/Login
rt/share/html/NoAuth/css/base/misc.css
rt/t/mail/gnupg-incoming.t
rt/t/web/crypt-gnupg.t

index 411d5b2..99a81c0 100644 (file)
@@ -108,8 +108,11 @@ tie my %rights, 'Tie::IxHash',
     'View customer',
     #'View Customer | View tickets',
     'Edit customer',
+    'Edit customer basics',
     'Edit customer tags',
     'Edit referring customer',
+    'Edit customer addresses',
+    'Edit customer billing information',
     'View customer history',
     'Suspend customer',
     'Unsuspend customer',
index 563d969..648195d 100644 (file)
@@ -217,6 +217,12 @@ sub _upgrade_data { # class method
                             'Usage: Call Detail Records (CDRs)',
                             'Usage: Unrateable CDRs',
                           ],
+
+    'Edit customer' => [ 'Edit customer basics',
+                         'Edit customer addresses',
+                         'Edit customer contacts',
+                       ],
+
   ;
 
   foreach my $old_acl ( keys %onetime ) {
index 3168c23..6ca6774 100755 (executable)
@@ -1,7 +1,7 @@
 #! /bin/sh
 # From configure.ac Revision.
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for RT 3.8.13.
+# Generated by GNU Autoconf 2.68 for RT 3.8.15.
 #
 # Report bugs to <rt-bugs@bestpractical.com>.
 #
@@ -560,8 +560,8 @@ MAKEFLAGS=
 # Identity of this package.
 PACKAGE_NAME='RT'
 PACKAGE_TARNAME='rt'
-PACKAGE_VERSION='3.8.14'
-PACKAGE_STRING='RT 3.8.14'
+PACKAGE_VERSION='3.8.15'
+PACKAGE_STRING='RT 3.8.15'
 PACKAGE_BUGREPORT='rt-bugs@bestpractical.com'
 PACKAGE_URL=''
 
@@ -1302,7 +1302,7 @@ if test "$ac_init_help" = "long"; then
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures RT 3.8.14 to adapt to many kinds of systems.
+\`configure' configures RT 3.8.15 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1363,7 +1363,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of RT 3.8.14:";;
+     short | recursive ) echo "Configuration of RT 3.8.15:";;
    esac
   cat <<\_ACEOF
 
@@ -1488,7 +1488,7 @@ fi
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-RT configure 3.8.13
+RT configure 3.8.15
 generated by GNU Autoconf 2.68
 
 Copyright (C) 2010 Free Software Foundation, Inc.
@@ -1589,7 +1589,7 @@ cat >config.log <<_ACEOF
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by RT $as_me 3.8.13, which was
+It was created by RT $as_me 3.8.15, which was
 generated by GNU Autoconf 2.68.  Invocation command line was
 
   $ $0 $@
@@ -1943,7 +1943,7 @@ rt_version_major=3
 
 rt_version_minor=8
 
-rt_version_patch=14
+rt_version_patch=15
 
 test "x$rt_version_major" = 'x' && rt_version_major=0
 test "x$rt_version_minor" = 'x' && rt_version_minor=0
@@ -4460,7 +4460,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by RT $as_me 3.8.13, which was
+This file was extended by RT $as_me 3.8.15, which was
 generated by GNU Autoconf 2.68.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -4513,7 +4513,7 @@ _ACEOF
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
 ac_cs_version="\\
-RT config.status 3.8.13
+RT config.status 3.8.15
 configured by $0, generated by GNU Autoconf 2.68,
   with options \\"\$ac_cs_config\\"
 
index a8f470a..76d52d2 100644 (file)
@@ -7,7 +7,7 @@ AC_REVISION($Revision: 1.4 $)dnl
 
 dnl Setup autoconf
 AC_PREREQ([2.53])
-AC_INIT(RT, 3.8.13, [rt-bugs@bestpractical.com])
+AC_INIT(RT, 3.8.15, [rt-bugs@bestpractical.com])
 AC_CONFIG_SRCDIR([lib/RT.pm.in])
 
 dnl Extract RT version number components
index a98a764..189b999 100755 (executable)
@@ -100,47 +100,31 @@ activated in the config.
 sub Commit {
     my $self = shift;
 
-    $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail');
+    return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
+        unless RT->Config->Get('RecordOutgoingEmail');
+
+    $self->DeferDigestRecipients();
     my $message = $self->TemplateObj->MIMEObj;
 
     my $orig_message;
-    if (   RT->Config->Get('RecordOutgoingEmail')
-        && RT->Config->Get('GnuPG')->{'Enable'} )
-    {
-
-        # it's hacky, but we should know if we're going to crypt things
-        my $attachment = $self->TransactionObj->Attachments->First;
-
-        my %crypt;
-        foreach my $argument (qw(Sign Encrypt)) {
-            if ( $attachment
-                && defined $attachment->GetHeader("X-RT-$argument") )
-            {
-                $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
-            } else {
-                $crypt{$argument} = $self->TicketObj->QueueObj->$argument();
-            }
-        }
-        if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) {
-            $orig_message = $message->dup;
-        }
-    }
+    $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
+        Attachment => $self->TransactionObj->Attachments->First,
+        Ticket     => $self->TicketObj,
+    );
 
     my ($ret) = $self->SendMessage($message);
-    if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) {
-        if ($orig_message) {
-            $message->attach(
-                Type        => 'application/x-rt-original-message',
-                Disposition => 'inline',
-                Data        => $orig_message->as_string,
-            );
-        }
-        $self->RecordOutgoingMailTransaction($message);
-        $self->RecordDeferredRecipients();
+    return abs( $ret ) if $ret <= 0;
+
+    if ($orig_message) {
+        $message->attach(
+            Type        => 'application/x-rt-original-message',
+            Disposition => 'inline',
+            Data        => $orig_message->as_string,
+        );
     }
-
-
-    return ( abs $ret );
+    $self->RecordOutgoingMailTransaction($message);
+    $self->RecordDeferredRecipients();
+    return 1;
 }
 
 =head2 Prepare
index 45a5ab6..cdc6770 100644 (file)
@@ -550,8 +550,8 @@ sub DelHeader {
 
     my $newheader = '';
     foreach my $line ($self->_SplitHeaders) {
-        next if $line =~ /^\Q$tag\E:\s+(.*)$/is;
-       $newheader .= "$line\n";
+        next if $line =~ /^\Q$tag\E:\s+/i;
+        $newheader .= "$line\n";
     }
     return $self->__Set( Field => 'Headers', Value => $newheader);
 }
@@ -567,9 +567,7 @@ sub AddHeader {
 
     my $newheader = $self->__Value( 'Headers' );
     while ( my ($tag, $value) = splice @_, 0, 2 ) {
-        $value = '' unless defined $value;
-        $value =~ s/\s+$//s;
-        $value =~ s/\r+\n/\n /g;
+        $value = $self->_CanonicalizeHeaderValue($value);
         $newheader .= "$tag: $value\n";
     }
     return $self->__Set( Field => 'Headers', Value => $newheader);
@@ -582,24 +580,39 @@ Replace or add a Header to the attachment's headers.
 =cut
 
 sub SetHeader {
-    my $self = shift;
-    my $tag = shift;
+    my $self  = shift;
+    my $tag   = shift;
+    my $value = $self->_CanonicalizeHeaderValue(shift);
 
+    my $replaced  = 0;
     my $newheader = '';
-    foreach my $line ($self->_SplitHeaders) {
-        if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) {
-           $newheader .= "$tag: $_[0]\n";
-           undef $tag;
+    foreach my $line ( $self->_SplitHeaders ) {
+        if ( $line =~ /^\Q$tag\E:\s+/i ) {
+            # replace first instance, skip all the rest
+            unless ($replaced) {
+                $newheader .= "$tag: $value\n";
+                $replaced = 1;
+            }
+        } else {
+            $newheader .= "$line\n";
         }
-       else {
-           $newheader .= "$line\n";
-       }
     }
 
-    $newheader .= "$tag: $_[0]\n" if defined $tag;
+    $newheader .= "$tag: $value\n" unless $replaced;
     $self->__Set( Field => 'Headers', Value => $newheader);
 }
 
+sub _CanonicalizeHeaderValue {
+    my $self  = shift;
+    my $value = shift;
+
+    $value = '' unless defined $value;
+    $value =~ s/\s+$//s;
+    $value =~ s/\r*\n/\n /g;
+
+    return $value;
+}
+
 =head2 SplitHeaders
 
 Returns an array of this attachment object's headers, with one header 
@@ -626,6 +639,12 @@ sub _SplitHeaders {
     my $self = shift;
     my $headers = (shift || $self->SUPER::Headers());
     my @headers;
+    # XXX TODO: splitting on \n\w is _wrong_ as it treats \n[ as a valid
+    # continuation, which it isn't.  The correct split pattern, per RFC 2822,
+    # is /\n(?=[^ \t]|\z)/.  That is, only "\n " or "\n\t" is a valid
+    # continuation.  Older values of X-RT-GnuPG-Status contain invalid
+    # continuations and rely on this bogus split pattern, however, so it is
+    # left as-is for now.
     for (split(/\n(?=\w|\z)/,$headers)) {
         push @headers, $_;
 
index 314e6cc..91f974c 100644 (file)
@@ -896,6 +896,19 @@ sub FindProtectedParts {
             $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
             return ();
         }
+
+        # Deal with "partitioned" PGP mail, which (contrary to common
+        # sense) unnecessarily applies a base64 transfer encoding to PGP
+        # mail (whose content is already base64-encoded).
+        if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
+            pipe( my ($read_decoded, $write_decoded) );
+            my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
+            if ($decoder) {
+                eval { $decoder->decode($io, $write_decoded) };
+                $io = $read_decoded;
+            }
+        }
+
         while ( defined($_ = $io->getline) ) {
             next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
             my $type = $1? 'signed': 'encrypted';
@@ -1060,9 +1073,13 @@ sub VerifyDecrypt {
         }
         if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
             my $method = $args{'AddStatus'} ? 'add' : 'set';
+            # Let the header be modified so continuations are handled
+            my $modify = $status_on->head->modify;
+            $status_on->head->modify(1);
             $status_on->head->$method(
                 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
             );
+            $status_on->head->modify($modify);
         }
     }
     foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
@@ -1079,9 +1096,13 @@ sub VerifyDecrypt {
         }
         if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
             my $method = $args{'AddStatus'} ? 'add' : 'set';
+            # Let the header be modified so continuations are handled
+            my $modify = $status_on->head->modify;
+            $status_on->head->modify(1);
             $status_on->head->$method(
                 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
             );
+            $status_on->head->modify($modify);
         }
     }
     return @res;
@@ -1673,6 +1694,7 @@ my %ignore_keyword = map { $_ => 1 } qw(
     BEGIN_ENCRYPTION SIG_ID VALIDSIG
     ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
     TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
+    DECRYPTION_INFO
 );
 
 sub ParseStatus {
@@ -2096,7 +2118,9 @@ sub GetKeysInfo {
     eval {
         local $SIG{'CHLD'} = 'DEFAULT';
         my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
-        my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email? (command_args => $email) : () ) };
+        my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email
+                                                        ? (command_args => [ "--", $email])
+                                                        : () ) };
         close $handle{'stdin'};
         waitpid $pid, 0;
     };
@@ -2291,7 +2315,7 @@ sub DeleteKey {
         my $pid = safe_run_child { $gnupg->wrap_call(
             handles => $handles,
             commands => ['--delete-secret-and-public-key'],
-            command_args => [$key],
+            command_args => ["--", $key],
         ) };
         close $handle{'stdin'};
         while ( my $str = readline $handle{'status'} ) {
index 37b1545..678f1db 100755 (executable)
@@ -318,6 +318,35 @@ header field then it's value is used
 
 =cut
 
+sub WillSignEncrypt {
+    my %args = @_;
+    my $attachment = delete $args{Attachment};
+    my $ticket     = delete $args{Ticket};
+
+    if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
+        $args{Sign} = $args{Encrypt} = 0;
+        return wantarray ? %args : 0;
+    }
+
+    for my $argument ( qw(Sign Encrypt) ) {
+        next if defined $args{ $argument };
+
+        if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
+            $args{$argument} = $attachment->GetHeader("X-RT-$argument");
+        } elsif ( $ticket and $argument eq "Encrypt" ) {
+            $args{Encrypt} = $ticket->QueueObj->Encrypt();
+        } elsif ( $ticket and $argument eq "Sign" ) {
+            # Note that $queue->Sign is UI-only, and that all
+            # UI-generated messages explicitly set the X-RT-Crypt header
+            # to 0 or 1; thus this path is only taken for messages
+            # generated _not_ via the web UI.
+            $args{Sign} = $ticket->QueueObj->SignAuto();
+        }
+    }
+
+    return wantarray ? %args : ($args{Sign} || $args{Encrypt});
+}
+
 sub SendEmail {
     my (%args) = (
         Entity => undef,
@@ -366,23 +395,12 @@ sub SendEmail {
     }
 
     if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
-        my %crypt;
-
-        my $attachment;
-        $attachment = $TransactionObj->Attachments->First
-            if $TransactionObj;
-
-        foreach my $argument ( qw(Sign Encrypt) ) {
-            next if defined $args{ $argument };
-
-            if ( $attachment && defined $attachment->GetHeader("X-RT-$argument") ) {
-                $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
-            } elsif ( $TicketObj ) {
-                $crypt{$argument} = $TicketObj->QueueObj->$argument();
-            }
-        }
-
-        my $res = SignEncrypt( %args, %crypt );
+        %args = WillSignEncrypt(
+            %args,
+            Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
+            Ticket     => $TicketObj,
+        );
+        my $res = SignEncrypt( %args );
         return $res unless $res > 0;
     }
 
@@ -905,7 +923,7 @@ sub EncodeToMIME {
         return ($value);
     }
 
-    return ($value) unless $value =~ /[^\x20-\x7e]/;
+    return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
 
     $value =~ s/\s+$//;
 
index 6d43b96..846c013 100755 (executable)
@@ -77,8 +77,9 @@ sub GetCurrentUser {
 
     foreach my $p ( $args{'Message'}->parts_DFS ) {
         $p->head->delete($_) for qw(
-            X-RT-GnuPG-Status X-RT-Incoming-Encrypton
+            X-RT-GnuPG-Status X-RT-Incoming-Encryption
             X-RT-Incoming-Signature X-RT-Privacy
+            X-RT-Sign X-RT-Encrypt
         );
     }
 
index 61c06ac..a8cffb8 100644 (file)
@@ -244,12 +244,12 @@ sub HandleRequest {
             }
             # Specially handle /index.html so that we get a nicer URL
             elsif ( $m->request_comp->path eq '/index.html' ) {
-                my $next = SetNextPage(RT->Config->Get('WebURL'));
+                my $next = SetNextPage($ARGS);
                 $m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]);
                 $m->abort;
             }
             else {
-                TangentForLogin(results => ($msg ? LoginError($msg) : undef));
+                TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef));
             }
         }
     }
@@ -298,7 +298,7 @@ sub LoginError {
     return $key;
 }
 
-=head2 SetNextPage [PATH]
+=head2 SetNextPage ARGSRef [PATH]
 
 Intuits and stashes the next page in the sesssion hash.  If PATH is
 specified, uses that instead of the value of L<IntuitNextPage()>.  Returns
@@ -307,24 +307,68 @@ the hash value.
 =cut
 
 sub SetNextPage {
-    my $next = shift || IntuitNextPage();
+    my $ARGS = shift;
+    my $next = $_[0] ? $_[0] : IntuitNextPage();
     my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024));
+    my $page = { url => $next };
+
+    # If an explicit URL was passed and we didn't IntuitNextPage, then
+    # IsPossibleCSRF below is almost certainly unrelated to the actual
+    # destination.  Currently explicit next pages aren't used in RT, but the
+    # API is available.
+    if (not $_[0] and RT->Config->Get("RestrictReferrer")) {
+        # This isn't really CSRF, but the CSRF heuristics are useful for catching
+        # requests which may have unintended side-effects.
+        my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
+        if ($is_csrf) {
+            RT->Logger->notice(
+                "Marking original destination as having side-effects before redirecting for login.\n"
+               ."Request: $next\n"
+               ."Reason: " . HTML::Mason::Commands::loc($msg, @loc)
+            );
+            $page->{'HasSideEffects'} = [$msg, @loc];
+        }
+    }
 
-    $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $next;
+    $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page;
     $HTML::Mason::Commands::session{'i'}++;
     return $hash;
 }
 
+=head2 FetchNextPage HASHKEY
+
+Returns the stashed next page hashref for the given hash.
+
+=cut
+
+sub FetchNextPage {
+    my $hash = shift || "";
+    return $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
+
+=head2 RemoveNextPage HASHKEY
+
+Removes the stashed next page for the given hash and returns it.
+
+=cut
+
+sub RemoveNextPage {
+    my $hash = shift || "";
+    return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
 
-=head2 TangentForLogin [HASH]
+=head2 TangentForLogin ARGSRef [HASH]
 
 Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
-the next page.  Optionally takes a hash which is dumped into query params.
+the next page.  Takes a hashref of request %ARGS as the first parameter.
+Optionally takes all other parameters as a hash which is dumped into query
+params.
 
 =cut
 
 sub TangentForLogin {
-    my $hash  = SetNextPage();
+    my $ARGS  = shift;
+    my $hash  = SetNextPage($ARGS);
     my %query = (@_, next => $hash);
     my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?';
     $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
@@ -339,8 +383,9 @@ calls L<TangentForLogin> with the appropriate results key.
 =cut
 
 sub TangentForLoginWithError {
-    my $key = LoginError(HTML::Mason::Commands::loc(@_));
-    TangentForLogin( results => $key );
+    my $ARGS = shift;
+    my $key  = LoginError(HTML::Mason::Commands::loc(@_));
+    TangentForLogin( $ARGS, results => $key );
 }
 
 =head2 IntuitNextPage
@@ -529,6 +574,8 @@ sub AttemptExternalAuth {
             $user =~ s/^\Q$NodeName\E\\//i;
         }
 
+        my $next = RemoveNextPage($ARGS->{'next'});
+           $next = $next->{'url'} if ref $next;
         InstantiateNewSession() unless _UserLoggedIn;
         $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
         $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);
@@ -567,7 +614,7 @@ sub AttemptExternalAuth {
                 delete $HTML::Mason::Commands::session{'CurrentUser'};
 
                 if (RT->Config->Get('WebFallbackToInternalAuth')) {
-                    TangentForLoginWithError('Cannot create user: [_1]', $msg);
+                    TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg);
                 } else {
                     $m->abort();
                 }
@@ -576,18 +623,27 @@ sub AttemptExternalAuth {
 
         if ( _UserLoggedIn() ) {
             $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' );
+            # It is possible that we did a redirect to the login page,
+            # if the external auth allows lack of auth through with no
+            # REMOTE_USER set, instead of forcing a "permission
+            # denied" message.  Honor the $next.
+            Redirect($next) if $next;
+            # Unlike AttemptPasswordAuthentication below, we do not
+            # force a redirect to / if $next is not set -- otherwise,
+            # straight-up external auth would always redirect to /
+            # when you first hit it.
         } else {
             delete $HTML::Mason::Commands::session{'CurrentUser'};
             $user = $orig_user;
 
-            if ( RT->Config->Get('WebExternalOnly') ) {
-                TangentForLoginWithError('You are not an authorized user');
+            unless ( RT->Config->Get('WebFallbackToInternalAuth') ) {
+                TangentForLoginWithError($ARGS, 'You are not an authorized user');
             }
         }
     } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) {
         unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) {
             # XXX unreachable due to prior defaulting in HandleRequest (check c34d108)
-            TangentForLoginWithError('You are not an authorized user');
+            TangentForLoginWithError($ARGS, 'You are not an authorized user');
         }
     } else {
 
@@ -618,7 +674,8 @@ sub AttemptPasswordAuthentication {
 
         # It's important to nab the next page from the session before we blow
         # the session away
-        my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+        my $next = RemoveNextPage($ARGS->{'next'});
+           $next = $next->{'url'} if ref $next;
 
         InstantiateNewSession();
         $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
@@ -1048,6 +1105,13 @@ our %is_whitelisted_component = (
     '/Search/Simple.html'  => 1,
 );
 
+# Components which are blacklisted from automatic, argument-based whitelisting.
+# These pages are not idempotent when called with just an id.
+our %is_blacklisted_component = (
+    # Takes only id and toggles bookmark state
+    '/Helpers/Toggle/TicketBookmark' => 1,
+);
+
 sub IsCompCSRFWhitelisted {
     my $comp = shift;
     my $ARGS = shift;
@@ -1070,6 +1134,10 @@ sub IsCompCSRFWhitelisted {
         delete $args{pass};
     }
 
+    # Some pages aren't idempotent even with safe args like id; blacklist
+    # them from the automatic whitelisting below.
+    return 0 if $is_blacklisted_component{$comp};
+
     # Eliminate arguments that do not indicate an effectful request.
     # For example, "id" is acceptable because that is how RT retrieves a
     # record.
@@ -1249,6 +1317,29 @@ sub MaybeShowInterstitialCSRFPage {
     # Calls abort, never gets here
 }
 
+our @POTENTIAL_PAGE_ACTIONS = (
+    qr'/Ticket/Create.html' => "create a ticket",              # loc
+    qr'/Ticket/'            => "update a ticket",              # loc
+    qr'/Admin/'             => "modify RT's configuration",    # loc
+    qr'/Approval/'          => "update an approval",           # loc
+    qr'/Dashboards/'        => "modify a dashboard",           # loc
+    qr'/m/ticket/'          => "update a ticket",              # loc
+    qr'Prefs'               => "modify your preferences",      # loc
+    qr'/Search/'            => "modify or access a search",    # loc
+    qr'/SelfService/Create' => "create a ticket",              # loc
+    qr'/SelfService/'       => "update a ticket",              # loc
+);
+
+sub PotentialPageAction {
+    my $page = shift;
+    my @potentials = @POTENTIAL_PAGE_ACTIONS;
+    while (my ($pattern, $result) = splice @potentials, 0, 2) {
+        return HTML::Mason::Commands::loc($result)
+            if $page =~ $pattern;
+    }
+    return "";
+}
+
 package HTML::Mason::Commands;
 
 use vars qw/$r $m %session/;
@@ -1397,10 +1488,8 @@ sub CreateTicket {
         }
     }
 
-    foreach my $argument (qw(Encrypt Sign)) {
-        $MIMEObj->head->add(
-            "X-RT-$argument" => Encode::encode_utf8( $ARGS{$argument} )
-        ) if defined $ARGS{$argument};
+    for my $argument (qw(Encrypt Sign)) {
+        $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
     }
 
     my %create_args = (
index 0c8f168..a348293 100644 (file)
@@ -336,6 +336,7 @@ sub Create {
         FinalPriority     => 0,
         DefaultDueIn      => 0,
         Sign              => undef,
+        SignAuto          => undef,
         Encrypt           => undef,
         _RecordTransaction => 1,
         @_
@@ -370,14 +371,11 @@ sub Create {
     }
     $RT::Handle->Commit;
 
-    if ( defined $args{'Sign'} ) {
-        my ($status, $msg) = $self->SetSign( $args{'Sign'} );
-        $RT::Logger->error("Couldn't set attribute 'Sign': $msg")
-            unless $status;
-    }
-    if ( defined $args{'Encrypt'} ) {
-        my ($status, $msg) = $self->SetEncrypt( $args{'Encrypt'} );
-        $RT::Logger->error("Couldn't set attribute 'Encrypt': $msg")
+    for my $attr (qw/Sign SignAuto Encrypt/) {
+        next unless defined $args{$attr};
+        my $set = "Set" . $attr;
+        my ($status, $msg) = $self->$set( $args{$attr} );
+        $RT::Logger->error("Couldn't set attribute '$attr': $msg")
             unless $status;
     }
 
@@ -524,6 +522,32 @@ sub SetSign {
     return ($status, $self->loc('Signing disabled'));
 }
 
+sub SignAuto {
+    my $self = shift;
+    my $value = shift;
+
+    return undef unless $self->CurrentUserHasRight('SeeQueue');
+    my $attr = $self->FirstAttribute('SignAuto') or return 0;
+    return $attr->Content;
+}
+
+sub SetSignAuto {
+    my $self = shift;
+    my $value = shift;
+
+    return ( 0, $self->loc('Permission Denied') )
+        unless $self->CurrentUserHasRight('AdminQueue');
+
+    my ($status, $msg) = $self->SetAttribute(
+        Name        => 'SignAuto',
+        Description => 'Sign auto-generated outgoing messages',
+        Content     => $value,
+    );
+    return ($status, $msg) unless $status;
+    return ($status, $self->loc('Signing enabled')) if $value;
+    return ($status, $self->loc('Signing disabled'));
+}
+
 sub Encrypt {
     my $self = shift;
     my $value = shift;
index 21cb97a..963a87b 100644 (file)
@@ -383,6 +383,7 @@ sub _Parse {
 
     # Unfold all headers
     $self->{'MIMEObj'}->head->unfold;
+    $self->{'MIMEObj'}->head->modify(1);
 
     return ( 1, $self->loc("Template parsed") );
 
index 2b50fac..998f849 100644 (file)
@@ -94,6 +94,7 @@ sub _OverlayAccessible {
           AuthSystem            => { public => 1,  admin => 1 },
           Gecos                 => { public => 1,  admin => 1 },
           PGPKey                => { public => 1,  admin => 1 },
+          PrivateKey            => {               admin => 1 },
 
     }
 }
index 5dd7bf0..5bb5c26 100755 (executable)
 <td align="right"><input type="checkbox" class="checkbox" name="Encrypt" value="1" <% $QueueObj->Encrypt? 'checked="checked"': '' |n%> /></td>
 <td><&|/l&>Encrypt by default</&></td>
 </tr>
+<tr><td align="right"><input type="checkbox" class="checkbox" name="SignAuto" value="1" <% $QueueObj->SignAuto? 'checked="checked"': '' |n%> /></td>
+<td colspan="3"><&|/l_unsafe, "<b>","</b>","<i>","</i>"&>Sign all auto-generated mail.  [_1]Caution[_2]: Enabling this option alters the signature from providing [_3]authentication[_4] to providing [_3]integrity[_4].</&></td></tr>
 % }
 
 <tr><td align="right"><input type="checkbox" class="checkbox" name="Enabled" value="1" <%$EnabledChecked|n%> /></td>
@@ -180,13 +182,13 @@ if ($Create) {
 if ( $QueueObj->Id ) {
     delete $session{'create_in_queues'};
     my @attribs= qw(Description CorrespondAddress CommentAddress Name
-        InitialPriority FinalPriority DefaultDueIn Sign Encrypt SubjectTag Disabled);
+        InitialPriority FinalPriority DefaultDueIn Sign SignAuto Encrypt SubjectTag Disabled);
 
     # we're asking about enabled on the web page but really care about disabled
     if ( $SetEnabled ) {
         $Disabled = $ARGS{'Disabled'} = $Enabled? 0: 1;
         $ARGS{$_} = 0 foreach grep !defined $ARGS{$_} || !length $ARGS{$_},
-            qw(Sign Encrypt Disabled);
+            qw(Sign SignAuto Encrypt Disabled);
     }
 
     push @results, UpdateRecordObject(
index de11993..63e175e 100644 (file)
@@ -69,7 +69,7 @@
 <& /Widgets/Form/Select,
     Name         => 'PrivateKey',
     Description  => loc('Private Key'),
-    Values       => [ map $_->{'Key'}, @{ $keys_meta{'info'} } ],
+    Values       => \@potential_keys,
     CurrentValue => $UserObj->PrivateKey,
     DefaultLabel => loc('No private key'),
 &>
@@ -96,7 +96,8 @@ unless ( $UserObj->id ) {
 $id = $ARGS{'id'} = $UserObj->id;
 
 my $email = $UserObj->EmailAddress;
-my %keys_meta = RT::Crypt::GnuPG::GetKeysForSigning( $email, 'force' );
+my %keys_meta = RT::Crypt::GnuPG::GetKeysForSigning( $email );
+my @potential_keys = map $_->{'Key'}, @{ $keys_meta{'info'} || [] };
 
 $ARGS{'PrivateKey'} = $m->comp('/Widgets/Form/Select:Process',
     Name      => 'PrivateKey',
@@ -105,8 +106,14 @@ $ARGS{'PrivateKey'} = $m->comp('/Widgets/Form/Select:Process',
 );
 
 if ( $Update ) {
-    my ($status, $msg) = $UserObj->SetPrivateKey( $ARGS{'PrivateKey'} );
-    push @results, $msg;
+    if (not $ARGS{'PrivateKey'} or grep {$_ eq $ARGS{'PrivateKey'}} @potential_keys) {
+        if (($ARGS{'PrivateKey'}||'') ne ($UserObj->PrivateKey||'')) {
+            my ($status, $msg) = $UserObj->SetPrivateKey( $ARGS{'PrivateKey'} );
+            push @results, $msg;
+        }
+    } else {
+        push @results, loc("Invalid key [_1] for address '[_2]'", $ARGS{'PrivateKey'}, $email);
+    }
 }
 
 my $title = loc("[_1]'s GnuPG keys",$UserObj->Name);
index b7c1575..21a5306 100644 (file)
 
 % my $strong_start = "<strong>";
 % my $strong_end   = "</strong>";
-<p><&|/l_unsafe, $strong_start, $strong_end, $Reason &>RT has detected a possible [_1]cross-site request forgery[_2] for this request, because [_3].  This is possibly caused by a malicious attacker trying to perform actions against RT on your behalf. If you did not initiate this request, then you should alert your security team.</&></p>
+<p><&|/l_unsafe, $strong_start, $strong_end, $Reason, $action &>RT has detected a possible [_1]cross-site request forgery[_2] for this request, because [_3].  A malicious attacker may be trying to [_1][_4][_2] on your behalf. If you did not initiate this request, then you should alert your security team.</&></p>
 
 % my $start = qq|<strong><a href="$url_with_token">|;
 % my $end   = qq|</a></strong>|;
-<p><&|/l_unsafe, $escaped_path, $start, $end &>If you really intended to visit [_1], then [_2]click here to resume your request[_3].</&></p>
+<p><&|/l_unsafe, $escaped_path, $action, $start, $end &>If you really intended to visit [_1] and [_2], then [_3]click here to resume your request[_4].</&></p>
 
 <& /Elements/Footer, %ARGS &>
 % $m->abort;
@@ -71,4 +71,6 @@ $escaped_path = "<tt>$escaped_path</tt>";
 
 my $url_with_token = URI->new($OriginalURL);
 $url_with_token->query_form([CSRF_Token => $Token]);
+
+my $action = RT::Interface::Web::PotentialPageAction($OriginalURL) || loc("perform actions");
 </%INIT>
index 8be14af..a26f6ec 100644 (file)
@@ -124,12 +124,16 @@ if ( $self->{'Sign'} ) {
     $QueueObj ||= $TicketObj->QueueObj
         if $TicketObj;
 
-    my $address = $self->{'SignUsing'};
-    $address ||= ($self->{'UpdateType'} && $self->{'UpdateType'} eq "private")
+    my $private = $session{'CurrentUser'}->UserObj->PrivateKey || '';
+    my $queue = ($self->{'UpdateType'} && $self->{'UpdateType'} eq "private")
         ? ( $QueueObj->CommentAddress || RT->Config->Get('CommentAddress') )
         : ( $QueueObj->CorrespondAddress || RT->Config->Get('CorrespondAddress') );
 
-    unless ( RT::Crypt::GnuPG::DrySign( $address ) ) {
+    my $address = $self->{'SignUsing'} || $queue;
+    if ($address ne $private and $address ne $queue) {
+        push @{ $self->{'GnuPGCanNotSignAs'} ||= [] }, $address;
+        $checks_failure = 1;
+    } elsif ( not RT::Crypt::GnuPG::DrySign( $address ) ) {
         push @{ $self->{'GnuPGCanNotSignAs'} ||= [] }, $address;
         $checks_failure = 1;
     } else {
index eb645d4..936ad6a 100755 (executable)
@@ -65,6 +65,8 @@
 <div id="login-box">
 <&| /Widgets/TitleBox, title => loc('Login'), titleright => $RT::VERSION, hideable => 0 &>
 
+<& LoginRedirectWarning, %ARGS &>
+
 % unless (RT->Config->Get('WebExternalAuth') and !RT->Config->Get('WebFallbackToInternalAuth')) {
 <form id="login" name="login" method="post" action="<% RT->Config->Get('WebPath') %>/NoAuth/Login.html">
 
index ede9dae..8670a59 100644 (file)
@@ -98,3 +98,12 @@ hr.clear {
     border: none;
     font-size: 1px;
 }
+
+.redirect-warning tt {
+    display: block;
+    margin: 0.5em 0 0.5em 1em;
+    white-space: nowrap;
+    overflow: hidden;
+    text-overflow: ellipsis;
+    width: 90%;
+}
index 230aa9c..c34ed99 100644 (file)
@@ -2,18 +2,18 @@
 use strict;
 use warnings;
 
-use RT::Test tests => 39;
+use RT::Test tests => 47;
 
 plan skip_all => 'GnuPG required.'
     unless eval 'use GnuPG::Interface; 1';
 plan skip_all => 'gpg executable is required.'
     unless RT::Test->find_executable('gpg');
 
-
 use File::Temp;
 use Cwd 'getcwd';
 use String::ShellQuote 'shell_quote';
 use IPC::Run3 'run3';
+use MIME::Base64;
 
 my $homedir = RT::Test::get_abs_relocatable_dir(File::Spec->updir(),
     qw(data gnupg keyrings));
@@ -206,6 +206,44 @@ RT::Test->close_mailgate_ok($mail);
     ok(index($orig->Content, $buf) != -1, 'found original msg');
 }
 
+
+# test that if it gets base64 transfer-encoded, we still get the content out
+$buf = encode_base64($buf);
+$mail = RT::Test->open_mailgate_ok($baseurl);
+print $mail <<"EOF";
+From: recipient\@example.com
+To: general\@$RT::rtname
+Content-transfer-encoding: base64
+Subject: Encrypted message for queue
+
+$buf
+EOF
+RT::Test->close_mailgate_ok($mail);
+
+{
+    my $tick = RT::Test->last_ticket;
+    is( $tick->Subject, 'Encrypted message for queue',
+        "Created the ticket"
+    );
+
+    my $txn = $tick->Transactions->First;
+    my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
+
+    is( $msg->GetHeader('X-RT-Incoming-Encryption'),
+        'Success',
+        'recorded incoming mail that is encrypted'
+    );
+    is( $msg->GetHeader('X-RT-Privacy'),
+        'PGP',
+        'recorded incoming mail that is encrypted'
+    );
+    like( $attach->Content, qr/orz/);
+
+    is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
+    ok(index($orig->Content, $buf) != -1, 'found original msg');
+}
+
+
 # test for signed mail by other key
 $buf = '';
 
index fb28c88..1a317af 100644 (file)
@@ -8,6 +8,7 @@ plan skip_all => 'GnuPG required.'
 plan skip_all => 'gpg executable is required.'
     unless RT::Test->find_executable('gpg');
 
+use MIME::Head;
 
 use RT::Action::SendEmail;
 
@@ -95,8 +96,7 @@ $user->SetEmailAddress('general@example.com');
 for my $mail (@mail) {
     unlike $mail, qr/Some content/, "outgoing mail was encrypted";
 
-    my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
-    my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+    my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
     my $body = strip_headers($mail);
 
     $mail = << "MAIL";
@@ -163,8 +163,7 @@ for my $mail (@mail) {
     like $mail, qr/Some other content/, "outgoing mail was not encrypted";
     like $mail, qr/-----BEGIN PGP SIGNATURE-----[\s\S]+-----END PGP SIGNATURE-----/, "data has some kind of signature";
 
-    my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
-    my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+    my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
     my $body = strip_headers($mail);
 
     $mail = << "MAIL";
@@ -235,8 +234,7 @@ ok(@mail, "got some mail");
 for my $mail (@mail) {
     unlike $mail, qr/Some other content/, "outgoing mail was encrypted";
 
-    my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
-    my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+    my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
     my $body = strip_headers($mail);
 
     $mail = << "MAIL";
@@ -301,8 +299,7 @@ ok(@mail, "got some mail");
 for my $mail (@mail) {
     like $mail, qr/Thought you had me figured out didya/, "outgoing mail was unencrypted";
 
-    my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
-    my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+    my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
     my $body = strip_headers($mail);
 
     $mail = << "MAIL";
@@ -348,6 +345,20 @@ MAIL
     like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
 }
 
+sub get_headers {
+    my $mail = shift;
+    open my $fh, "<", \$mail or die $!;
+    my $head = MIME::Head->read($fh);
+    return @{[
+        map {
+            my $hdr = "$_: " . $head->get($_);
+            chomp $hdr;
+            $hdr;
+        }
+        @_
+    ]};
+}
+
 sub strip_headers
 {
     my $mail = shift;