+sub SendForward {
+ my (%args) = (
+ Entity => undef,
+ Ticket => undef,
+ Transaction => undef,
+ Template => 'Forward',
+ To => '', Cc => '', Bcc => '',
+ @_
+ );
+
+ my $txn = $args{'Transaction'};
+ my $ticket = $args{'Ticket'};
+ $ticket ||= $txn->Object if $txn;
+
+ my $entity = $args{'Entity'};
+ unless ( $entity ) {
+ require Carp;
+ $RT::Logger->error(Carp::longmess("No entity provided"));
+ return (0, $ticket->loc("Couldn't send email"));
+ }
+
+ my ($template, $msg) = PrepareEmailUsingTemplate(
+ Template => $args{'Template'},
+ Arguments => {
+ Ticket => $ticket,
+ Transaction => $txn,
+ },
+ );
+
+ my $mail;
+ if ( $template ) {
+ $mail = $template->MIMEObj;
+ } else {
+ $RT::Logger->warning($msg);
+ }
+ unless ( $mail ) {
+ $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
+
+ my $description;
+ unless ( $args{'Transaction'} ) {
+ $description = 'This is forward of ticket #'. $ticket->id;
+ } else {
+ $description = 'This is forward of transaction #'
+ . $txn->id ." of a ticket #". $txn->ObjectId;
+ }
+ $mail = MIME::Entity->build(
+ Type => 'text/plain',
+ Data => $description,
+ );
+ }
+
+ $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
+ foreach grep defined $args{$_}, qw(To Cc Bcc);
+
+ $mail->make_multipart unless $mail->is_multipart;
+ $mail->add_part( $entity );
+
+ my $from;
+ unless (defined $mail->head->get('Subject')) {
+ my $subject = '';
+ $subject = $txn->Subject if $txn;
+ $subject ||= $ticket->Subject if $ticket;
+
+ unless ( RT->Config->Get('ForwardFromUser') ) {
+ # XXX: what if want to forward txn of other object than ticket?
+ $subject = AddSubjectTag( $subject, $ticket );
+ }
+
+ $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
+ }
+
+ $mail->head->set(
+ From => EncodeToMIME(
+ String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
+ )
+ );
+
+ my $status = RT->Config->Get('ForwardFromUser')
+ # never sign if we forward from User
+ ? SendEmail( %args, Entity => $mail, Sign => 0 )
+ : SendEmail( %args, Entity => $mail );
+ return (0, $ticket->loc("Couldn't send email")) unless $status;
+ return (1, $ticket->loc("Sent email successfully"));
+}
+
+=head2 GetForwardFrom Ticket => undef, Transaction => undef
+
+Resolve the From field to use in forward mail
+
+=cut
+
+sub GetForwardFrom {
+ my %args = ( Ticket => undef, Transaction => undef, @_ );
+ my $txn = $args{Transaction};
+ my $ticket = $args{Ticket} || $txn->Object;
+
+ if ( RT->Config->Get('ForwardFromUser') ) {
+ return ( $txn || $ticket )->CurrentUser->EmailAddress;
+ }
+ else {
+ return $ticket->QueueObj->CorrespondAddress
+ || RT->Config->Get('CorrespondAddress');
+ }
+}
+
+=head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
+
+Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
+handle errors with users' keys.
+
+If a recipient has no key or has other problems with it, then the
+unction sends a error to him using 'Error: public key' template.
+Also, notifies RT's owner using template 'Error to RT owner: public key'
+to inform that there are problems with users' keys. Then we filter
+all bad recipients and retry.
+
+Returns 1 on success, 0 on error and -1 if all recipients are bad and
+had been filtered out.
+
+=cut
+
+sub SignEncrypt {
+ my %args = (
+ Entity => undef,
+ Sign => 0,
+ Encrypt => 0,
+ @_
+ );
+ return 1 unless $args{'Sign'} || $args{'Encrypt'};
+
+ my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
+ chomp $msgid;
+
+ $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
+ $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
+
+ require RT::Crypt::GnuPG;
+ my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
+ return 1 unless $res{'exit_code'};
+
+ my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
+
+ my @bad_recipients;
+ foreach my $line ( @status ) {
+ # if the passphrase fails, either you have a bad passphrase
+ # or gpg-agent has died. That should get caught in Create and
+ # Update, but at least throw an error here
+ if (($line->{'Operation'}||'') eq 'PassphraseCheck'
+ && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
+ $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
+ return 0;
+ }
+ next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
+ next if $line->{'Status'} eq 'DONE';
+ $RT::Logger->error( $line->{'Message'} );
+ push @bad_recipients, $line;
+ }
+ return 0 unless @bad_recipients;
+
+ $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
+ foreach @bad_recipients;
+
+ foreach my $recipient ( @bad_recipients ) {
+ my $status = SendEmailUsingTemplate(
+ To => $recipient->{'AddressObj'}->address,
+ Template => 'Error: public key',
+ Arguments => {
+ %$recipient,
+ TicketObj => $args{'Ticket'},
+ TransactionObj => $args{'Transaction'},
+ },
+ );
+ unless ( $status ) {
+ $RT::Logger->error("Couldn't send 'Error: public key'");
+ }
+ }
+
+ my $status = SendEmailUsingTemplate(
+ To => RT->Config->Get('OwnerEmail'),
+ Template => 'Error to RT owner: public key',
+ Arguments => {
+ BadRecipients => \@bad_recipients,
+ TicketObj => $args{'Ticket'},
+ TransactionObj => $args{'Transaction'},
+ },
+ );
+ unless ( $status ) {
+ $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
+ }
+
+ DeleteRecipientsFromHead(
+ $args{'Entity'}->head,
+ map $_->{'AddressObj'}->address, @bad_recipients
+ );
+
+ unless ( $args{'Entity'}->head->get('To')
+ || $args{'Entity'}->head->get('Cc')
+ || $args{'Entity'}->head->get('Bcc') )
+ {
+ $RT::Logger->debug("$msgid No recipients that have public key, not sending");
+ return -1;
+ }
+
+ # redo without broken recipients
+ %res = RT::Crypt::GnuPG::SignEncrypt( %args );
+ return 0 if $res{'exit_code'};
+
+ return 1;
+}
+
+use MIME::Words ();
+
+=head2 EncodeToMIME
+
+Takes a hash with a String and a Charset. Returns the string encoded
+according to RFC2047, using B (base64 based) encoding.
+
+String must be a perl string, octets are returned.
+
+If Charset is not provided then $EmailOutputEncoding config option
+is used, or "latin-1" if that is not set.
+
+=cut
+
+sub EncodeToMIME {
+ my %args = (
+ String => undef,
+ Charset => undef,
+ @_
+ );
+ my $value = $args{'String'};
+ return $value unless $value; # 0 is perfect ascii
+ my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
+ my $encoding = 'B';
+
+ # using RFC2047 notation, sec 2.
+ # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
+
+ # An 'encoded-word' may not be more than 75 characters long
+ #
+ # MIME encoding increases 4/3*(number of bytes), and always in multiples
+ # of 4. Thus we have to find the best available value of bytes available
+ # for each chunk.
+ #
+ # First we get the integer max which max*4/3 would fit on space.
+ # Then we find the greater multiple of 3 lower or equal than $max.
+ my $max = int(
+ ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
+ * 3
+ ) / 4
+ );
+ $max = int( $max / 3 ) * 3;
+
+ chomp $value;
+
+ if ( $max <= 0 ) {
+
+ # gives an error...
+ $RT::Logger->crit("Can't encode! Charset or encoding too big.");
+ return ($value);
+ }
+
+ return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
+
+ $value =~ s/\s+$//;
+
+ # we need perl string to split thing char by char
+ Encode::_utf8_on($value) unless Encode::is_utf8($value);
+
+ my ( $tmp, @chunks ) = ( '', () );
+ while ( length $value ) {
+ my $char = substr( $value, 0, 1, '' );
+ my $octets = Encode::encode( $charset, $char );
+ if ( length($tmp) + length($octets) > $max ) {
+ push @chunks, $tmp;
+ $tmp = '';
+ }
+ $tmp .= $octets;
+ }
+ push @chunks, $tmp if length $tmp;
+
+ # encode an join chuncks
+ $value = join "\n ",
+ map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
+ @chunks;
+ return ($value);
+}