From: Ivan Kohler Date: Thu, 20 Dec 2012 07:12:14 +0000 (-0800) Subject: Merge branch 'patch-1' of https://github.com/gjones2/Freeside X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=a72a10f754f7465121d6137bb3dcee0a21ea6443;hp=e7a9ba25d437b6a145a6260594c27f9dc0ac0495 Merge branch 'patch-1' of https://github.com/gjones2/Freeside --- diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index b38c2671d..66624e179 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -277,6 +277,7 @@ tie my %rights, 'Tie::IxHash', 'Financial reports', { rightname=> 'List inventory', global=>1 }, { rightname=>'View email logs', global=>1 }, + { rightname=>'View system logs' }, 'Download report data', 'Services: Accounts', diff --git a/FS/FS/ClientAPI/PrepaidPhone.pm b/FS/FS/ClientAPI/PrepaidPhone.pm index c34617922..c7317ea23 100644 --- a/FS/FS/ClientAPI/PrepaidPhone.pm +++ b/FS/FS/ClientAPI/PrepaidPhone.pm @@ -3,6 +3,7 @@ package FS::ClientAPI::PrepaidPhone; use strict; use vars qw($DEBUG $me); use FS::Record qw(qsearchs); +use FS::Conf; use FS::rate; use FS::svc_phone; @@ -156,11 +157,15 @@ sub call_time { return \%return; } + my $conf = new FS::Conf; + my $balance = $conf->config_bool('pkg-balances') ? $cust_pkg->balance + : $cust_main->balance; + #XXX granularity? included minutes? another day... - if ( $cust_main->balance >= 0 ) { + if ( $balance >= 0 ) { return { 'error'=>'No balance' }; } else { - $return{'seconds'} = int(60 * abs($cust_main->balance) / $rate_detail->min_charge); + $return{'seconds'} = int(60 * abs($balance) / $rate_detail->min_charge); } warn "$me returning seconds: ". $return{'seconds'}; @@ -248,13 +253,18 @@ sub phonenum_balance { my $cust_pkg = $svc_phone->cust_svc->cust_pkg; - warn "$me returning ". $cust_pkg->cust_main->balance. - " balance for custnum ". $cust_pkg->custnum + my $conf = new FS::Conf; + my $balance = $conf->config_bool('pkg-balances') + ? $cust_pkg->balance + : $cust_pkg->cust_main->balance; + + warn "$me returning $balance balance for pkgnum ". $cust_pkg->pkgnum. + ", custnum ". $cust_pkg->custnum if $DEBUG; return { 'custnum' => $cust_pkg->custnum, - 'balance' => $cust_pkg->cust_main->balance, + 'balance' => $balance, }; } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 7f3fcaa38..d11916faf 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -749,6 +749,15 @@ sub reason_type_options { }, { + 'key' => 'event_log_level', + 'section' => 'notification', + 'description' => 'Store events in the internal log if they are at least this severe. "info" is the default, "debug" is very detailed and noisy.', + 'type' => 'select', + 'select_enum' => [ '', 'debug', 'info', 'notice', 'warning', 'error', ], + # don't bother with higher levels + }, + + { 'key' => 'log_sent_mail', 'section' => 'notification', 'description' => 'Enable logging of template-generated email.', @@ -1478,7 +1487,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.', 'type' => 'select', - 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], + 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 18', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], }, { diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index a9df376dc..6e110e852 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -13,6 +13,8 @@ use FS::cust_main; use FS::part_event; use FS::part_event_condition; +use FS::Log; + @ISA = qw( Exporter ); @EXPORT_OK = qw ( bill bill_where ); @@ -27,6 +29,9 @@ use FS::part_event_condition; sub bill { my %opt = @_; + my $log = FS::Log->new('Cron::bill'); + $log->info('start'); + my $check_freq = $opt{'check_freq'} || '1d'; my $debug = 0; @@ -134,6 +139,7 @@ sub bill { $cursor_dbh->commit or die $cursor_dbh->errstr; + $log->info('finish'); } # freeside-daily %opt: diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm index 08819fce9..628c6801b 100644 --- a/FS/FS/Cron/upload.pm +++ b/FS/FS/Cron/upload.pm @@ -9,6 +9,7 @@ use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::queue; use FS::agent; +use FS::Log; use FS::Misc qw( send_email ); #for bridgestone use FS::upload_target; use LWP::UserAgent; @@ -33,6 +34,8 @@ $me = '[FS::Cron::upload]'; sub upload { my %opt = @_; + my $log = FS::Log->new('Cron::upload'); + $log->info('start'); my $debug = 0; $debug = 1 if $opt{'v'}; @@ -95,6 +98,32 @@ sub upload { } } # foreach @agents + # if there's nothing to do, don't hold up the rest of the process + if (!@tasks) { + $log->info('finish (nothing to upload)'); + return ''; + } + + # wait for any ongoing billing jobs to complete + if ($opt{m}) { + my $dbh = dbh; + my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". + "WHERE queue.job='FS::cust_main::queued_bill' AND status != 'failed'"; + if (@agents) { + $sql .= ' AND cust_main.agentnum IN('. + join(',', map {$_->agentnum} @agents). + ')'; + } + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + while (1) { + $sth->execute() + or die "Unexpected error executing statement $sql: ". $sth->errstr; + last if $sth->fetchrow_arrayref->[0] == 0; + warn "Waiting 5min for billing to complete...\n" if $DEBUG; + sleep 300; + } + } + foreach (@tasks) { my $agentnum = $_->{agentnum}; @@ -119,11 +148,13 @@ sub upload { } } + $log->info('finish'); } sub spool_upload { my %opt = @_; + my $log = FS::Log->new('spool_upload'); warn "$me spool_upload called\n" if $DEBUG; my $conf = new FS::Conf; @@ -143,6 +174,8 @@ sub spool_upload { my $dbh = dbh; my $agentnum = $opt{agentnum}; + $log->debug('start', agentnum => $agentnum); + my $agent; if ( $agentnum ) { $agent = qsearchs( 'agent', { agentnum => $agentnum } ) @@ -160,6 +193,8 @@ sub spool_upload { { warn "$me neither $dir/$file-header.csv nor ". "$dir/$file-detail.csv found\n" if $DEBUG > 1; + $log->debug("finish (neither $file-header.csv nor ". + "$file-detail.csv found)"); $dbh->commit or die $dbh->errstr if $oldAutoCommit; return; } @@ -170,19 +205,6 @@ sub spool_upload { my $username = $opt{username} or die "no username for agent $agentnum\n"; my $password = $opt{password} or die "no password for agent $agentnum\n"; - # a better way? - if ($opt{m}) { - my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". - "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - while (1) { - $sth->execute( $agentnum ) - or die "Unexpected error executing statement $sql: ". $sth->errstr; - last if $sth->fetchrow_arrayref->[0]; - sleep 300; - } - } - foreach ( qw ( header detail ) ) { rename "$dir/$file-$_.csv", "$dir/$file-$date-$_.csv"; @@ -252,6 +274,7 @@ sub spool_upload { unless ( -f "$dir/$file.csv" ) { warn "$me $dir/$file.csv not found\n" if $DEBUG > 1; + $log->debug("finish ($dir/$file.csv not found)"); $dbh->commit or die $dbh->errstr if $oldAutoCommit; return; } @@ -326,14 +349,16 @@ sub spool_upload { } } - send_report('bridgestone-confirm_template', - { - agentnum=> $agentnum, - zipfile => $zipfile, - prefix => $prefix, - seq => $seq, - rows => $rows, - } + send_email( + prepare_report('bridgestone-confirm_template', + { + agentnum=> $agentnum, + zipfile => $zipfile, + prefix => $prefix, + seq => $seq, + rows => $rows, + } + ) ); $seq++; @@ -376,16 +401,26 @@ sub spool_upload { close $reg; close $big; + # zip up all three files for transport my $zipfile = "$basename" . '.zip'; my $command = "cd $dir; zip $zipfile $regfile $bigfile"; system($command) and die "'$command' failed\n"; - my $error = $upload_target->put("$dir/$zipfile"); + # upload them, unless we're using email, in which case + # the zip file will ride along with the report. yes, this + # kind of defeats the purpose of the upload_target interface, + # but at least we have a place to store the configuration. + my $error = ''; + if ( $upload_target->protocol ne 'email' ) { + $error = $upload_target->put("$dir/$zipfile"); + } + + # create the report for (values %sum) { $_ = sprintf('%.2f', $_); } - send_report('ics-confirm_template', + my %report = prepare_report('ics-confirm_template', { agentnum => $agentnum, count => \%count, @@ -393,8 +428,23 @@ sub spool_upload { error => $error, } ); + if ( $upload_target->protocol eq 'email' ) { + $report{'to'} = + join('@', $upload_target->username, $upload_target->hostname); + $report{'subject'} = $upload_target->subject; + $report{'mimeparts'} = [ + { Path => "$dir/$zipfile", + Type => 'application/zip', + Encoding => 'base64', + Filename => $zipfile, + Disposition => 'attachment', + } + ]; + } + $error = send_email(%report); if ( $error ) { + # put the original spool file back rename "$dir/$file-$date.csv", "$dir/$file.csv"; die $error; } @@ -413,6 +463,8 @@ sub spool_upload { } #opt{handling} + $log->debug('finish', agentnum => $agentnum); + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -421,7 +473,8 @@ sub spool_upload { =item send_report CONFIG PARAMS Retrieves the config value named CONFIG, parses it as a Text::Template, -extracts "to" and "subject" headers, and sends it by email. +extracts "to" and "subject" headers, and returns a hash that can be passed +to L. PARAMS is a hashref to be passed to C. It must contain 'agentnum' to look up the per-agent config. @@ -429,7 +482,8 @@ PARAMS is a hashref to be passed to C. It must contain =cut # we used it twice, so it's now a subroutine -sub send_report { + +sub prepare_report { my ($config, $params) = @_; my $agentnum = $params->{agentnum}; @@ -452,7 +506,7 @@ sub send_report { $head =~ /^to:\s*(.*)$/im; my $to = $1; - send_email( + ( to => $to, from => $conf->config('invoice_from', $agentnum), subject => $subject, diff --git a/FS/FS/Log.pm b/FS/FS/Log.pm new file mode 100644 index 000000000..b11630bc9 --- /dev/null +++ b/FS/FS/Log.pm @@ -0,0 +1,103 @@ +package FS::Log; + +use base 'Log::Dispatch'; +use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::Log::Output; +use FS::log; +use vars qw(@STACK @LEVELS); + +# override the stringification of @_ with something more sensible. +BEGIN { + @LEVELS = qw(debug info notice warning error critical alert emergency); + + foreach my $l (@LEVELS) { + my $sub = sub { + my $self = shift; + $self->log( level => $l, message => @_ ); + }; + no strict 'refs'; + *{$l} = $sub; + } +} + +=head1 NAME + +FS::Log - Freeside event log + +=head1 SYNOPSIS + +use FS::Log; + +sub do_something { + my $log = FS::Log->new('do_something'); # set log context to 'do_something' + + ... + if ( $error ) { + $log->error('something is wrong: '.$error); + return $error; + } + # at this scope exit, do_something is removed from context +} + +=head1 DESCRIPTION + +FS::Log provides an interface for logging errors and profiling information +to the database. FS::Log inherits from L. + +=head1 CLASS METHODS + +=over 4 + +new CONTEXT + +Constructs and returns a log handle. CONTEXT must be a known context tag +indicating what activity is going on, such as the name of the function or +script that is executing. + +Log context is a stack, and each element is removed from the stack when it +goes out of scope. So don't keep log handles in persistent places (i.e. +package variables or class-scoped lexicals). + +=cut + +sub new { + my $class = shift; + my $context = shift; + + my $min_level = FS::Conf->new->config('event_log_level') || 'info'; + + my $self = $class->SUPER::new( + outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ], + ); + $self->{'index'} = scalar(@STACK); + push @STACK, $context; + return $self; +} + +=item context + +Returns the current context stack. + +=cut + +sub context { @STACK }; + +=item log LEVEL, MESSAGE[, OPTIONS ] + +Like L, but OPTIONS may include: + +- agentnum +- object (an object to reference in this log message) +- tablename and tablenum (an alternate way of specifying 'object') + +=cut + +# inherited + +sub DESTROY { + my $self = shift; + splice(@STACK, $self->{'index'}, 1); # delete the stack entry +} + +1; diff --git a/FS/FS/Log/Output.pm b/FS/FS/Log/Output.pm new file mode 100644 index 000000000..18d7f1b43 --- /dev/null +++ b/FS/FS/Log/Output.pm @@ -0,0 +1,50 @@ +package FS::Log::Output; + +use base Log::Dispatch::Output; +use FS::Record qw( dbdef ); + +sub new { # exactly by the book + my $proto = shift; + my $class = ref $proto || $proto; + + my %p = @_; + + my $self = bless {}, $class; + + $self->_basic_init(%p); + + return $self; +} + +sub log_message { + my $self = shift; + my %m = @_; + + my $object = $m{'object'}; + my ($tablename, $tablenum) = @m{'tablename', 'tablenum'}; + if ( $object and $object->isa('FS::Record') ) { + $tablename = $object->table; + $tablenum = $object->get( dbdef->table($tablename)->primary_key ); + + # get the agentnum from the object if it has one + $m{'agentnum'} ||= $object->get('agentnum'); + # maybe FS::cust_main_Mixin objects should use the customer's agentnum? + # I'm trying not to do database lookups in here, though. + } + + my $entry = FS::log->new({ + _date => time, + agentnum => $m{'agentnum'}, + tablename => ($tablename || ''), + tablenum => ($tablenum || ''), + level => $self->_level_as_number($m{'level'}), + message => $m{'message'}, + }); + my $error = $entry->insert( FS::Log->context ); + if ( $error ) { + # guh? + warn "Error writing log entry: $error"; + } +} + +1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 944a4836c..2bc1596f2 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -56,6 +56,8 @@ if ( -e $addl_handler_use_file ) { #use CGI::Carp qw(fatalsToBrowser); use CGI::Cookie; use List::Util qw( max min sum ); + use List::MoreUtils qw( first_index uniq ); + use Scalar::Util qw( blessed ); use Data::Dumper; use Date::Format; use Time::Local; @@ -82,6 +84,7 @@ if ( -e $addl_handler_use_file ) { use IO::Handle; use IO::File; use IO::Scalar; + use IO::String; #not actually using this yet anyway...# use IPC::Run3 0.036; use Net::Whois::Raw qw(whois); if ( $] < 5.006 ) { @@ -327,6 +330,8 @@ if ( -e $addl_handler_use_file ) { use FS::agent_pkg_class; use FS::svc_export_machine; use FS::GeocodeCache; + use FS::log; + use FS::log_context; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 9eb59a09a..172ac8296 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -191,6 +191,7 @@ sub dbdef_dist { foreach my $table ( grep { ! /^clientapi_session/ && ! /^h_/ + && ! /^log(_context)?$/ && ! $tables_hashref_torrus->{$_} } $dbdef->tables @@ -3972,6 +3973,32 @@ sub tables_hashref { 'index' => [], }, + 'log' => { + 'columns' => [ + 'lognum', 'serial', '', '', '', '', + '_date', 'int', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'tablename', 'varchar', 'NULL', $char_d, '', '', + 'tablenum', 'int', 'NULL', '', '', '', + 'level', 'int', '', '', '', '', + 'message', 'text', '', '', '', '', + ], + 'primary_key' => 'lognum', + 'unique' => [], + 'index' => [ ['_date'], ['level'] ], + }, + + 'log_context' => { + 'columns' => [ + 'logcontextnum', 'serial', '', '', '', '', + 'lognum', 'int', '', '', '', '', + 'context', 'varchar', '', 32, '', '', + ], + 'primary_key' => 'logcontextnum', + 'unique' => [ [ 'lognum', 'context' ] ], + 'index' => [], + }, + %{ tables_hashref_torrus() }, # tables of ours for doing torrus virtual port combining diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 826569b25..a83af1326 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -665,8 +665,9 @@ sub set_display { =item disintegrate -Returns a list of cust_bill_pkg objects each with no more than a single class -(including setup or recur) of charge. +Returns a hash: keys are "setup", "recur" or usage classnum, values are +FS::cust_bill_pkg objects, each with no more than a single class (setup or +recur) of charge. =cut @@ -843,6 +844,18 @@ sub _X_show_zero { $self->cust_pkg->_X_show_zero($what); } +=item credited [ BEFORE, AFTER, OPTIONS ] + +Returns the sum of credits applied to this item. Arguments are the same as +owed_sql/paid_sql/credited_sql. + +=cut + +sub credited { + my $self = shift; + $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum); +} + =back =head1 CLASS METHODS diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 6185fc472..dfe55fb63 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -172,7 +172,7 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert + #false laziness w/ cust_pay::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; #return @@ -618,6 +618,262 @@ sub credited_sql { unapplied_sql(); } +=item credit_lineitems + +Example: + + my $error = FS::cust_credit->credit_lineitems( + + #the lineitems to credit + 'billpkgnums' => \@billpkgnums, + 'setuprecurs' => \@setuprecurs, + 'amounts' => \@amounts, + + #the credit + 'newreasonnum' => scalar($cgi->param('newreasonnum')), + 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')), + map { $_ => scalar($cgi->param($_)) } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + + ); + +=cut + +#maybe i should just be an insert with extra args instead of a class method +use FS::cust_bill_pkg; +sub credit_lineitems { + my( $class, %arg ) = @_; + + my $curuser = $FS::CurrentUser::CurrentUser; + + #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html + + my $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $arg{custnum} }, + 'extra_sql' => ' AND '. $curuser->agentnums_sql, + }) or return 'unknown customer'; + + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #my @cust_bill_pkg = qsearch({ + # 'select' => 'cust_bill_pkg.*', + # 'table' => 'cust_bill_pkg', + # 'addl_from' => ' LEFT JOIN cust_bill USING (invnum) '. + # ' LEFT JOIN cust_main USING (custnum) ', + # 'extra_sql' => ' WHERE custnum = $custnum AND billpkgnum IN ('. + # join( ',', @{$arg{billpkgnums}} ). ')', + # 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC', + #}); + + my $error = ''; + if ($arg{reasonnum} == -1) { + + $error = 'Enter a new reason (or select an existing one)' + unless $arg{newreasonnum} !~ /^\s*$/; + my $reason = new FS::reason { + 'reason' => $arg{newreasonnum}, + 'reason_type' => $arg{newreasonnum_type}, + }; + $error ||= $reason->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting reason: $error"; + } + $arg{reasonnum} = $reason->reasonnum; + } + + my $cust_credit = new FS::cust_credit ( { + map { $_ => $arg{$_} } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + } ); + $error = $cust_credit->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting credit: $error"; + } + + #my $subtotal = 0; + my $taxlisthash = {}; + my %cust_credit_bill = (); + my %cust_bill_pkg = (); + my %cust_credit_bill_pkg = (); + foreach my $billpkgnum ( @{$arg{billpkgnums}} ) { + my $setuprecur = shift @{$arg{setuprecurs}}; + my $amount = shift @{$arg{amounts}}; + + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'hashref' => { 'billpkgnum' => $billpkgnum }, + 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)', + 'extra_sql' => 'AND custnum = '. $cust_main->custnum, + }) or die "unknown billpkgnum $billpkgnum"; + + if ( $setuprecur eq 'setup' ) { + $cust_bill_pkg->setup($amount); + $cust_bill_pkg->recur(0); + $cust_bill_pkg->unitrecur(0); + $cust_bill_pkg->type(''); + } else { + $setuprecur = 'recur'; #in case its a usage classnum? + $cust_bill_pkg->recur($amount); + $cust_bill_pkg->setup(0); + $cust_bill_pkg->unitsetup(0); + } + + push @{$cust_bill_pkg{$cust_bill_pkg->invnum}}, $cust_bill_pkg; + + #unapply any payments applied to this line item (other credits too?) + foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) { + $error = $cust_bill_pay_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error unapplying payment: $error"; + } + } + + #$subtotal += $amount; + $cust_credit_bill{$cust_bill_pkg->invnum} += $amount; + push @{ $cust_credit_bill_pkg{$cust_bill_pkg->invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'amount' => $amount, + 'setuprecur' => $setuprecur, + 'sdate' => $cust_bill_pkg->sdate, + 'edate' => $cust_bill_pkg->edate, + }; + + my $part_pkg = $cust_bill_pkg->part_pkg; + $cust_main->_handle_taxes( $part_pkg, + $taxlisthash, + $cust_bill_pkg, + $cust_bill_pkg->cust_pkg, + $cust_bill_pkg->cust_bill->_date, + $cust_bill_pkg->cust_pkg->pkgpart, + ); + } + + ### + # now loop through %cust_credit_bill and insert those + ### + + # (hack to prevent cust_credit_bill_pkg insertion) + local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1; + + foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) { + + #taxes + + if ( @{ $cust_bill_pkg{$invnum} } ) { + + my $listref_or_error = + $cust_main->calculate_taxes( $cust_bill_pkg{$invnum}, $taxlisthash, $cust_bill_pkg{$invnum}->[0]->cust_bill->_date ); + + unless ( ref( $listref_or_error ) ) { + $dbh->rollback if $oldAutoCommit; + return "Error calculating taxes: $listref_or_error"; + } + + # so, loop through the taxlines, apply just that amount to the tax line + # item (save for later insert) & add to $ + + #my @taxlines = (); + #my $taxtotal = 0; + foreach my $taxline ( @$listref_or_error ) { + + #find equivalent tax line items on the existing invoice + # (XXX need a more specific/deterministic way to find these than itemdesc..) + my $tax_cust_bill_pkg = qsearchs('cust_bill_pkg', { + 'invnum' => $invnum, + 'pkgnum' => 0, #$taxline->invnum + 'itemdesc' => $taxline->desc, + }); + + my $amount = $taxline->setup; + my $desc = $taxline->desc; + + foreach my $location ( $tax_cust_bill_pkg->cust_bill_pkg_tax_Xlocation ) { + + $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge + + #$taxtotal += $location->amount; + $amount -= $location->amount; + + #push @taxlines, + # #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ]; + # [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ]; + $cust_credit_bill{$invnum} += $location->amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum, + 'amount' => $location->amount, + 'setuprecur' => 'setup', + 'billpkgtaxlocationnum' => $location->billpkgtaxlocationnum, + 'billpkgtaxratelocationnum' => $location->billpkgtaxratelocationnum, + }; + + } + if ($amount > 0) { + #$taxtotal += $amount; + #push @taxlines, + # [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ]; + + $cust_credit_bill{$invnum} += $amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum, + 'amount' => $amount, + 'setuprecur' => 'setup', + }; + + } + } + + } + + #insert cust_credit_bill + + my $cust_credit_bill = new FS::cust_credit_bill { + 'crednum' => $cust_credit->crednum, + 'invnum' => $invnum, + 'amount' => $cust_credit_bill{$invnum}, + }; + $error = $cust_credit_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying credit of $cust_credit_bill{$invnum} ". + " to invoice $invnum: $error"; + } + + #and then insert cust_credit_bill_pkg for each cust_bill_pkg + foreach my $cust_credit_bill_pkg ( @{$cust_credit_bill_pkg{$invnum}} ) { + $cust_credit_bill_pkg->creditbillnum( $cust_credit_bill->creditbillnum ); + $error = $cust_credit_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying credit to line item: $error"; + } + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =back =head1 BUGS diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index 1521960d4..b86529b3d 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -324,6 +324,9 @@ sub move_to { my $dbh = dbh; my $error = ''; + # prevent this from failing because of pkg_svc quantity limits + local( $FS::cust_svc::ignore_quantity ) = 1; + if ( !$new->locationnum ) { $error = $new->insert; if ( $error ) { diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 11247a28f..3dc8f9cad 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -21,6 +21,7 @@ use FS::cust_bill_pkg_tax_rate_location; use FS::part_event; use FS::part_event_condition; use FS::pkg_category; +use FS::Log; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -104,6 +105,9 @@ options of those methods are also available. sub bill_and_collect { my( $self, %options ) = @_; + my $log = FS::Log->new('bill_and_collect'); + $log->debug('start', object => $self, agentnum => $self->agentnum); + my $error; #$options{actual_time} not $options{time} because freeside-daily -d is for @@ -168,6 +172,7 @@ sub bill_and_collect { } } $job->update_statustext('100,finished') if $job; + $log->debug('finish', object => $self, agentnum => $self->agentnum); ''; diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index eadcc1a55..e5a4485f9 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -22,6 +22,8 @@ install_callback FS::UID sub { $conf = new FS::Conf; }; +my %is_location = map { $_ => 1 } FS::cust_main::Location->location_fields; + =head1 NAME FS::cust_main::Import - Batch customer importing @@ -316,13 +318,14 @@ sub batch_import { custbatch => $custbatch, agentnum => $agentnum, refnum => $refnum, - country => $conf->config('countrydefault') || 'US', payby => $payby, #default paydate => '12/2037', #default ); my $billtime = time; my %cust_pkg = ( pkgpart => $pkgpart ); my %svc_x = (); + my %bill_location = (); + my %ship_location = (); foreach my $field ( @fields ) { if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) { @@ -351,6 +354,14 @@ sub batch_import { $svc_x{$1} = shift @columns; + } elsif ( $is_location{$field} ) { + + $bill_location{$field} = shift @columns; + + } elsif ( $field =~ /^ship_(.*)$/ and $is_location{$1} ) { + + $ship_location{$1} = shift @columns; + } else { #refnum interception @@ -379,6 +390,16 @@ sub batch_import { my $value = shift @columns; $cust_main{$field} = $value if length($value); } + } # foreach my $field + # finished importing columns + + $bill_location{'country'} ||= $conf->config('countrydefault') || 'US'; + $cust_main{'bill_location'} = FS::cust_location->new(\%bill_location); + if ( grep $_, values(%ship_location) ) { + $ship_location{'country'} ||= $conf->config('countrydefault') || 'US'; + $cust_main{'ship_location'} = FS::cust_location->new(\%ship_location); + } else { + $cust_main{'ship_location'} = $cust_main{'bill_location'}; } if ( defined $cust_main{'payinfo'} && length $cust_main{'payinfo'} ) { diff --git a/FS/FS/cust_main/Packages.pm b/FS/FS/cust_main/Packages.pm index 11c13e5dd..395cce7e0 100644 --- a/FS/FS/cust_main/Packages.pm +++ b/FS/FS/cust_main/Packages.pm @@ -58,7 +58,7 @@ action completes (such as running the customer's credit card successfully). Optional subject for a ticket created and attached to this customer -=item ticket_subject +=item ticket_queue Optional queue name for ticket additions diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 143f62ed3..87c1ca730 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -472,8 +472,11 @@ sub taxline { $_->taxnum($self->taxnum) foreach @new_exemptions; - if ( $cust_bill_pkg->billpkgnum ) { - die "tried to calculate tax exemptions on a previously billed line item\n"; + #if ( $cust_bill_pkg->billpkgnum ) { + + #no, need to do this to e.g. calculate tax credit amounts + #die "tried to calculate tax exemptions on a previously billed line item\n"; + # this is unnecessary # foreach my $cust_tax_exempt_pkg (@new_exemptions) { # my $error = $cust_tax_exempt_pkg->insert; @@ -482,7 +485,7 @@ sub taxline { # return "can't insert cust_tax_exempt_pkg: $error"; # } # } - } + #} # attach them to the line item push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 16adea3d7..22a7b2c03 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2650,6 +2650,18 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item balance + +Returns the balance for this specific package, when using +experimental package balance. + +=cut + +sub balance { + my $self = shift; + $self->cust_main->balance_pkgnum( $self->pkgnum ); +} + #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin =item cust_location @@ -2877,7 +2889,8 @@ sub transfer { } foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { + if($target{$cust_svc->svcpart} > 0 + or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option $target{$cust_svc->svcpart}--; my $new = new FS::cust_svc { $cust_svc->hash }; $new->pkgnum($dest_pkgnum); diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 52069316d..b608b2349 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -479,7 +479,7 @@ Returns a listref of html elements associated with this service's exports. sub export_links { my $self = shift; my $svc_x = $self->svc_x - or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ]; $svc_x->export_links; } diff --git a/FS/FS/log.pm b/FS/FS/log.pm new file mode 100644 index 000000000..a4ad214d0 --- /dev/null +++ b/FS/FS/log.pm @@ -0,0 +1,354 @@ +package FS::log; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbdef ); +use FS::UID qw( dbh driver_name ); +use FS::log_context; + +=head1 NAME + +FS::log - Object methods for log records + +=head1 SYNOPSIS + + use FS::log; + + $record = new FS::log \%hash; + $record = new FS::log { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log object represents a log entry. FS::log inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item lognum - primary key + +=item _date - Unix timestamp + +=item agentnum - L to which the log pertains. If it involves a +specific customer, package, service, invoice, or other agent-specific object, +this will be set to that agentnum. + +=item tablename - table name to which the log pertains, if any. + +=item tablenum - foreign key to that table. + +=item level - log level: 'debug', 'info', 'notice', 'warning', 'error', +'critical', 'alert', 'emergency'. + +=item message - contents of the log entry + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new log entry. Use FS::Log instead of calling this directly, +please. + +=cut + +sub table { 'log'; } + +=item insert [ CONTEXT... ] + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +CONTEXT may be a list of context tags to attach to this record. + +=cut + +sub insert { + # not using process_o2m for this, because we don't have a web interface + my $self = shift; + my $error = $self->SUPER::insert; + return $error if $error; + foreach ( @_ ) { + my $context = FS::log_context->new({ + 'lognum' => $self->lognum, + 'context' => $_ + }); + $error = $context->insert; + return $error if $error; + } + ''; +} + +# the insert method can be inherited from FS::Record + +sub delete { die "Log entries can't be modified." }; + +sub replace { die "Log entries can't be modified." }; + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('lognum') + || $self->ut_number('_date') + || $self->ut_numbern('agentnum') + || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_textn('tablename') + || $self->ut_numbern('tablenum') + || $self->ut_number('level') + || $self->ut_text('message') + ; + return $error if $error; + + if ( my $tablename = $self->tablename ) { + my $dbdef_table = dbdef->table($tablename) + or return "tablename '$tablename' does not exist"; + $error = $self->ut_foreign_key('tablenum', + $tablename, + $dbdef_table->primary_key); + return $error if $error; + } + + $self->SUPER::check; +} + +=item context + +Returns the context for this log entry, as an array, from least to most +specific. + +=cut + +sub context { + my $self = shift; + map { $_->context } qsearch({ + table => 'log_context', + hashref => { lognum => $self->lognum }, + order_by => 'ORDER BY logcontextnum ASC', + }); +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item search HASHREF + +Returns a qsearch hash expression to search for parameters specified in +HASHREF. Valid parameters are: + +=over 4 + +=item agentnum + +=item date - arrayref of start and end date + +=item level - either a specific level, or an arrayref of min and max level + +=item context - a context string that the log entry must have. This may +change in the future to allow searching for combinations of context strings. + +=item object - any database object, to find log entries related to it. + +=item tablename, tablenum - alternate way of specifying 'object'. + +=item custnum - a customer number, to find log entries related to the customer +or any of their subordinate objects (invoices, packages, etc.). + +=item message - a text string to search in messages. The search will be +a case-insensitive LIKE with % appended at both ends. + +=back + +=cut + +# used for custnum search: all tables with custnums +my @table_stubs; + +sub _setup_table_stubs { + foreach my $table ( + qw( + contact + cust_attachment + cust_bill + cust_credit + cust_location + cust_main + cust_main_exemption + cust_main_note + cust_msg + cust_pay + cust_pay_batch + cust_pay_pending + cust_pay_void + cust_pkg + cust_refund + cust_statement + cust_tag + cust_tax_adjustment + cust_tax_exempt + did_order_item + qual + queue ) ) + { + my $pkey = dbdef->table($table)->primary_key; + push @table_stubs, + "log.tablename = '$table' AND ". + "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ". + "$table.custnum = "; # needs a closing ) + } + # plus this case + push @table_stubs, + "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ". + "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ". + "cust_pkg.custnum = "; # needs a closing ) +} + +sub search { + my ($class, $params) = @_; + my @where; + + ## + # parse agent + ## + + if ( $params->{'agentnum'} =~ /^(\d+)$/ ) { + push @where, + "log.agentnum = $1"; + } + + ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ ) { + _setup_table_stubs() unless @table_stubs; + my $custnum = $1; + my @orwhere = map { "( $_ $custnum) )" } @table_stubs; + push @where, join(' OR ', @orwhere); + } + + ## + # parse level + ## + + if ( ref $params->{'level'} eq 'ARRAY' ) { + my ($min, $max) = @{ $params->{'level'} }; + if ( $min =~ /^\d+$/ ) { + push @where, "log.level >= $min"; + } + if ( $max =~ /^\d+$/ ) { + push @where, "log.level <= $max"; + } + } elsif ( $params->{'level'} =~ /^(\d+)$/ ) { + push @where, "log.level = $1"; + } + + ## + # parse date + ## + + if ( ref $params->{'date'} eq 'ARRAY' ) { + my ($beg, $end) = @{ $params->{'date'} }; + if ( $beg =~ /^\d+$/ ) { + push @where, "log._date >= $beg"; + } + if ( $end =~ /^\d+$/ ) { + push @where, "log._date <= $end"; + } + } + + ## + # parse object + ## + + if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) { + my $table = $params->{'object'}->table; + my $pkey = dbdef->table($table)->primary_key; + my $tablenum = $params->{'object'}->get($pkey); + if ( $table and $tablenum ) { + push @where, "log.tablename = '$table'", "log.tablenum = $tablenum"; + } + } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) { + my $table = $1; + if ( $params->{'tablenum'} =~ /^(\d+)$/ ) { + push @where, "log.tablename = '$table'", "log.tablenum = $1"; + } + } + + ## + # parse message + ## + + if ( $params->{'message'} ) { # can be anything, really, so escape it + my $quoted_message = dbh->quote('%' . $params->{'message'} . '%'); + my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE'); + push @where, "log.message $op $quoted_message"; + } + + ## + # parse context + ## + + if ( $params->{'context'} ) { + my $quoted = dbh->quote($params->{'context'}); + push @where, + "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ". + "AND log_context.context = $quoted)"; + } + + # agent virtualization + my $access_user = $FS::CurrentUser::CurrentUser; + push @where, $access_user->agentnums_sql( + table => 'log', + viewall_right => 'Configuration', + null => 1, + ); + + # put it together + my $extra_sql = ''; + $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where; + my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql; + my $sql_query = { + 'table' => 'log', + 'hashref' => {}, + 'select' => 'log.*', + 'extra_sql' => $extra_sql, + 'count_query' => $count_query, + 'order_by' => 'ORDER BY _date ASC', + #addl_from, not needed + }; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm new file mode 100644 index 000000000..372bdaa39 --- /dev/null +++ b/FS/FS/log_context.pm @@ -0,0 +1,145 @@ +package FS::log_context; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +my @contexts = ( qw( + test + bill_and_collect + Cron::bill + Cron::upload + spool_upload + daily + queue +) ); + +=head1 NAME + +FS::log_context - Object methods for log_context records + +=head1 SYNOPSIS + + use FS::log_context; + + $record = new FS::log_context \%hash; + $record = new FS::log_context { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log_context object represents a context tag attached to a log entry +(L). FS::log_context inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item logcontextnum - primary key + +=item lognum - lognum (L foreign key) + +=item context - context + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new context tag. To add the example to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'log_context'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('logcontextnum') + || $self->ut_number('lognum') + || $self->ut_enum('context', \@contexts) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item contexts + +Returns a list of all valid contexts. + +=cut + +sub contexts { @contexts } + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event/Condition/pkg_dundate.pm b/FS/FS/part_event/Condition/pkg_dundate.pm index f25db2ae8..fefee2022 100644 --- a/FS/FS/part_event/Condition/pkg_dundate.pm +++ b/FS/FS/part_event/Condition/pkg_dundate.pm @@ -19,7 +19,7 @@ sub condition { #my $cust_main = $self->cust_main($cust_pkg); - $cust_pkg->dundate <= $opt{time}; + ( $cust_pkg->dundate || 0 ) <= $opt{time}; } diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index b0f708a66..5d650626e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -615,6 +615,23 @@ sub weight { export_info()->{$self->exporttype}->{'weight'} || 0; } +=item info + +Returns a reference to (a copy of) the export's %info hash. + +=cut + +sub info { + my $self = shift; + $self->{_info} ||= { + %{ export_info()->{$self->exporttype} } + }; +} + +#default fallbacks... FS::part_export::DID_Common ? +sub get_dids_can_tollfree { 0; } +sub get_dids_npa_select { 1; } + =back =head1 SUBROUTINES diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm index 23df7b37d..af358997e 100644 --- a/FS/FS/part_export/acct_http.pm +++ b/FS/FS/part_export/acct_http.pm @@ -41,6 +41,18 @@ tie %options, 'Tie::IxHash', "password \$new->_password", ), }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', diff --git a/FS/FS/part_export/acct_xmlrpc.pm b/FS/FS/part_export/acct_xmlrpc.pm index 4c896b422..a493f5206 100644 --- a/FS/FS/part_export/acct_xmlrpc.pm +++ b/FS/FS/part_export/acct_xmlrpc.pm @@ -48,6 +48,8 @@ The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username +
  • $domain +
  • $email - username@domain
  • $_password
  • $crypt_password - encrypted password
  • $ldap_password - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4") @@ -196,8 +198,8 @@ sub _export_value { } else { return Frontier::RPC2::String->new( $svc_acct->$value() ); } - } elsif ( $value eq 'domain' ) { - return Frontier::RPC2::String->new( $svc_acct->domain ); + } elsif ( $value =~ /^(domain|email)$/ ) { + return Frontier::RPC2::String->new( $svc_acct->$value() ); } elsif ( $value eq 'crypt_password' ) { return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) ); } elsif ( $value eq 'ldap_password' ) { @@ -207,6 +209,7 @@ sub _export_value { #XXX } +#this is the "cust_main" email, not svc_acct->email # my $cust_pkg = $svc_acct->cust_svc->cust_pkg; # if ( $cust_pkg ) { # no strict 'vars'; diff --git a/FS/FS/part_export/broadband_http.pm b/FS/FS/part_export/broadband_http.pm index c1ed7fca6..5be8b6851 100644 --- a/FS/FS/part_export/broadband_http.pm +++ b/FS/FS/part_export/broadband_http.pm @@ -35,6 +35,18 @@ tie %options, 'Tie::IxHash', type => 'textarea', default => '', }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', diff --git a/FS/FS/part_export/broadband_snmp.pm b/FS/FS/part_export/broadband_snmp.pm index 44b4dbabb..9afca0872 100644 --- a/FS/FS/part_export/broadband_snmp.pm +++ b/FS/FS/part_export/broadband_snmp.pm @@ -3,7 +3,7 @@ package FS::part_export::broadband_snmp; use strict; use vars qw(%info $DEBUG); use base 'FS::part_export'; -use Net::SNMP qw(:asn1 :snmp); +use SNMP; use Tie::IxHash; $DEBUG = 0; @@ -11,21 +11,21 @@ $DEBUG = 0; my $me = '['.__PACKAGE__.']'; tie my %snmp_version, 'Tie::IxHash', - v1 => 'snmpv1', - v2c => 'snmpv2c', - # 3 => 'v3' not implemented + v1 => '1', + v2c => '2c', + # v3 unimplemented ; -tie my %snmp_type, 'Tie::IxHash', - i => INTEGER, - u => UNSIGNED32, - s => OCTET_STRING, - n => NULL, - o => OBJECT_IDENTIFIER, - t => TIMETICKS, - a => IPADDRESS, - # others not implemented yet -; +#tie my %snmp_type, 'Tie::IxHash', +# i => INTEGER, +# u => UNSIGNED32, +# s => OCTET_STRING, +# n => NULL, +# o => OBJECT_IDENTIFIER, +# t => TIMETICKS, +# a => IPADDRESS, +# # others not implemented yet +#; tie my %options, 'Tie::IxHash', 'version' => { label=>'SNMP version', @@ -33,14 +33,11 @@ tie my %options, 'Tie::IxHash', options => [ keys %snmp_version ], }, 'community' => { label=>'Community', default=>'public' }, - ( - map { $_.'_command', - { label => ucfirst($_) . ' commands', - type => 'textarea', - default => '', - } - } qw( insert delete replace suspend unsuspend ) - ), + + 'action' => { multiple=>1 }, + 'oid' => { multiple=>1 }, + 'value' => { multiple=>1 }, + 'ip_addr_change_to_new' => { label=>'Send IP address changes to new address', type=>'checkbox' @@ -51,28 +48,14 @@ tie my %options, 'Tie::IxHash', %info = ( 'svc' => 'svc_broadband', 'desc' => 'Send SNMP requests to the service IP address', + 'config_element' => '/edit/elements/part_export/broadband_snmp.html', 'options' => \%options, 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END' Send one or more SNMP SET requests to the IP address registered to the service. -Enter one command per line. Each command is a target OID, data type flag, -and value, separated by spaces. -The data type flag is one of the following: -
      -
    • i = INTEGER
      • -
    • u = UNSIGNED32
      • -
    • s = OCTET-STRING (as ASCII)
      • -
    • a = IPADDRESS
      • -
    • n = NULL
    The value may interpolate fields from svc_broadband by prefixing the field name with $, or $new_ and $old_ for replace operations. -The value may contain whitespace; quotes are not necessary.
    -
    -For example, to set the SNMPv2-MIB "sysName.0" object to the string -"svc_broadband" followed by the service number, use the following -command:
    -
    1.3.6.1.2.1.1.5.0 s svc_broadband$svcnum

    END ); @@ -105,19 +88,18 @@ sub export_command { my $self = shift; my ($action, $svc_new, $svc_old) = @_; - my $command_text = $self->option($action.'_command'); - return if !length($command_text); - - warn "$me parsing ${action}_command:\n" if $DEBUG; + my @a = split("\n", $self->option('action')); + my @o = split("\n", $self->option('oid')); + my @v = split("\n", $self->option('value')); my @commands; - foreach (split /\n/, $command_text) { - my ($oid, $type, $value) = split /\s/, $_, 3; - $oid =~ /^(\d+\.)*\d+$/ or die "invalid OID '$oid'\n"; - my $typenum = $snmp_type{$type} or die "unknown data type '$type'\n"; - $value = '' if !defined($value); # allow sending an empty string + warn "$me parsing $action commands:\n" if $DEBUG; + while (@a) { + my $oid = shift @o; + my $value = shift @v; + next unless shift(@a) eq $action; # ignore commands for other actions $value = $self->substitute($value, $svc_new, $svc_old); - warn "$me $oid $type $value\n" if $DEBUG; - push @commands, $oid, $typenum, $value; + warn "$me $oid :=$value\n" if $DEBUG; + push @commands, $oid, $value; } my $ip_addr = $svc_new->ip_addr; @@ -128,13 +110,13 @@ sub export_command { warn "$me opening session to $ip_addr\n" if $DEBUG; my %opt = ( - -hostname => $ip_addr, - -community => $self->option('community'), - -timeout => $self->option('timeout') || 20, + DestHost => $ip_addr, + Community => $self->option('community'), + Timeout => ($self->option('timeout') || 20) * 1000, ); my $version = $self->option('version'); - $opt{-version} = $snmp_version{$version} or die 'invalid version'; - $opt{-varbindlist} = \@commands; # just for now + $opt{Version} = $snmp_version{$version} or die 'invalid version'; + $opt{VarList} = \@commands; # for now $self->snmp_queue( $svc_new->svcnum, %opt ); } @@ -151,16 +133,22 @@ sub snmp_queue { sub snmp_request { my %opt = @_; - my $varbindlist = delete $opt{-varbindlist}; - my ($session, $error) = Net::SNMP->session(%opt); - die "Couldn't create SNMP session: $error" if !$session; + my $flatvarlist = delete $opt{VarList}; + my $session = SNMP::Session->new(%opt); warn "$me sending SET request\n" if $DEBUG; - my $result = $session->set_request( -varbindlist => $varbindlist ); - $error = $session->error(); - $session->close(); - if (!defined $result) { + my @varlist; + while (@$flatvarlist) { + my @this = splice(@$flatvarlist, 0, 2); + push @varlist, [ $this[0], 0, $this[1], undef ]; + # XXX new option to choose the IID (array index) of the object? + } + + $session->set(\@varlist); + my $error = $session->{ErrorStr}; + + if ( $session->{ErrorNum} ) { die "SNMP request failed: $error\n"; } } @@ -181,4 +169,46 @@ sub substitute { $value; } +sub _upgrade_exporttype { + eval 'use FS::Record qw(qsearch qsearchs)'; + # change from old style with numeric oid, data type flag, and value + # on consecutive lines + foreach my $export (qsearch('part_export', + { exporttype => 'broadband_snmp' } )) + { + # for the new options + my %new_options = ( + 'action' => [], + 'oid' => [], + 'value' => [], + ); + foreach my $action (qw(insert replace delete suspend unsuspend)) { + my $old_option = qsearchs('part_export_option', + { exportnum => $export->exportnum, + optionname => $action.'_command' } ); + next if !$old_option; + my $text = $old_option->optionvalue; + my @commands = split("\n", $text); + foreach (@commands) { + my ($oid, $type, $value) = split /\s/, $_, 3; + push @{$new_options{action}}, $action; + push @{$new_options{oid}}, $oid; + push @{$new_options{value}}, $value; + } + my $error = $old_option->delete; + warn "error migrating ${action}_command option: $error\n" if $error; + } + foreach (keys(%new_options)) { + my $new_option = FS::part_export_option->new({ + exportnum => $export->exportnum, + optionname => $_, + optionvalue => join("\n", @{ $new_options{$_} }) + }); + my $error = $new_option->insert; + warn "error inserting '$_' option: $error\n" if $error; + } + } #foreach $export + ''; +} + 1; diff --git a/FS/FS/part_export/fibernetics_did.pm b/FS/FS/part_export/fibernetics_did.pm new file mode 100644 index 000000000..fb0378550 --- /dev/null +++ b/FS/FS/part_export/fibernetics_did.pm @@ -0,0 +1,177 @@ +package FS::part_export::fibernetics_did; +use base qw( FS::part_export ); + +use strict; +use vars qw( %info $DEBUG ); +use Data::Dumper; +use URI::Escape; +#use Locale::SubCountry; +#use FS::Record qw(qsearch dbh); +use XML::Simple; +#use Net::HTTPS::Any qw( 0.10 https_get ); +use LWP::UserAgent; +use HTTP::Request::Common; + +$DEBUG = 0; + +tie my %options, 'Tie::IxHash', + 'country' => { 'label' => 'Country', 'default' => 'CA', size=>2, }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone numbers to Fibernetics web services API', + 'options' => \%options, + 'notes' => '', +); + +sub rebless { shift; } + +sub get_dids_can_tollfree { 0; }; +sub get_dids_npa_select { 0; }; + +# i guess we could get em from the API, but since its returning states without +# availability, there's no advantage + # not really needed, we maintain our own list of provinces, but would + # help to hide the ones without availability (need to fix the selector too) +our @states = ( + 'Alberta', + 'British Columbia', + 'Ontario', + 'Quebec', + #'Saskatchewan', + #'The Territories', + #'PEI/Nova Scotia', + #'Manitoba', + #'Newfoundland', + #'New Brunswick', +); + +sub get_dids { + my $self = shift; + my %opt = ref($_[0]) ? %{$_[0]} : @_; + + if ( $opt{'tollfree'} ) { + warn 'Fibernetics DID provisioning does not yet support toll-free numbers'; + return []; + } + + my %query_hash = (); + + #ratecenter + state: return numbers (more structured names, npa selection) + #areacode + exchange: return numbers + #areacode: return city/ratecenter/whatever + #state: return areacodes + + #region + state: return numbers (arbitrary names, no npa selection) + #state: return regions + +# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers +# +# $query_hash{'region'} = $opt{'exchange'}; +# +# } elsif ( $opt{'areacode'} ) { +# +# $query_hash{'npa'} = $opt{'areacode'}; + + #if ( $opt{'state'} && $opt{'region'} ) { #return numbers + if ( $opt{'region'} ) { #return numbers + + #$query_hash{'province'} = $country->full_name($opt{'state'}); + $query_hash{'region'} = $opt{'region'} + + } elsif ( $opt{'state'} ) { #return regions + + #my $country = new Locale::SubCountry( $self->option('country') ); + #$query_hash{'province'} = $country->full_name($opt{'state'}); + $query_hash{'province'} = $opt{'state'}; + $query_hash{'listregion'} = 1; + + } else { #nothing passed, return states (provinces) + + return \@states; + + } + + + my $url = 'http://'. $self->machine. '/porta/cgi-bin/porta_query.cgi'; + if ( keys %query_hash ) { + $url .= '?'. join('&', map "$_=". uri_escape($query_hash{$_}), + keys %query_hash + ); + } + warn $url if $DEBUG; + + #my( $page, $response, %reply_headers) = https_get( + # 'host' => $self->machine, + #); + + my $ua = LWP::UserAgent->new; + #my $response = $ua->$method( + # $url, \%data, + # 'Content-Type'=>'application/x-www-form-urlencoded' + #); + my $req = HTTP::Request::Common::GET( $url ); + my $response = $ua->request($req); + + die $response->error_as_HTML if $response->is_error; + + my $page = $response->content; + + my $data = XMLin( $page ); + + warn Dumper($data) if $DEBUG; + +# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers +# +# [ map $_->{'number'}, @{ $data->{'item'} } ]; +# +# } elsif ( $opt{'areacode'} ) { +# +# [ map $_->{'region'}, @{ $data->{'item'} } ]; +# +# } elsif ( $opt{'state'} ) { #return areacodes +# +# [ map $_->{'npa'}, @{ $data->{'item'} } ]; + + #if ( $opt{'state'} && $opt{'region'} ) { #return numbers + if ( $opt{'region'} ) { #return numbers + + [ map { $_ =~ /^(\d?)(\d{3})(\d{3})(\d{4})$/ + #? ($1 ? "$1 " : ''). "$2 $3 $4" + ? "$2 $3 $4" + : $_; + } + sort { $a <=> $b } + map $_->{'phone'}, + @{ $data->{'item'} } + ]; + + } elsif ( $opt{'state'} ) { #return regions + + #[ map $_->{'region'}, @{ $data->{'item'} } ]; + my %regions = map { $_ => 1 } map $_->{'region'}, @{ $data->{'item'} }; + [ sort keys %regions ]; + + #} else { #nothing passed, return states (provinces) + # not really needed, we maintain our own list of provinces, but would + # help to hide the ones without availability (need to fix the selector too) + } + + +} + +#insert, delete, etc... handled with shellcommands + +sub _export_insert { + #my( $self, $svc_phone ) = (shift, shift); +} +sub _export_delete { + #my( $self, $svc_phone ) = (shift, shift); +} + +sub _export_replace { ''; } +sub _export_suspend { ''; } +sub _export_unsuspend { ''; } + +1; diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index c35c89f12..0d62409fc 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -33,6 +33,18 @@ tie %options, 'Tie::IxHash', default => join("\n", ), }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', @@ -64,6 +76,16 @@ sub _export_delete { $self->_export_command('delete', @_); } +sub _export_suspend { + my $self = shift; + $self->_export_command('suspend', @_); +} + +sub _export_unsuspend { + my $self = shift; + $self->_export_command('unsuspend', @_); +} + sub _export_command { my( $self, $action, $svc_x ) = ( shift, shift, shift ); diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 6760d09b7..58cc5be95 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -213,6 +213,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } my @del = grep { !exists $new{$_} } keys %old; @@ -230,6 +231,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } } @@ -348,7 +350,7 @@ sub _export_delete { sub sqlradius_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); - my %args = @_; + #my %args = @_; my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlradius::sqlradius_$method", @@ -561,6 +563,7 @@ sub sqlreplace_usergroups { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } if ( @newgroups ) { diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm index 350a5ad48..3c0534fc1 100644 --- a/FS/FS/part_export/vitelity.pm +++ b/FS/FS/part_export/vitelity.pm @@ -39,6 +39,8 @@ END sub rebless { shift; } +sub get_dids_can_tollfree { 1; }; + sub get_dids { my $self = shift; my %opt = ref($_[0]) ? %{$_[0]} : @_; diff --git a/FS/FS/pay_batch/eft_canada.pm b/FS/FS/pay_batch/eft_canada.pm index ea9d58402..220fecb3d 100644 --- a/FS/FS/pay_batch/eft_canada.pm +++ b/FS/FS/pay_batch/eft_canada.pm @@ -112,7 +112,7 @@ my %holiday = ( } push @fields, sprintf('%05s', $branch), sprintf('%03s', $bankno), - sprintf('%012s', $account), + $account, sprintf('%.02f', $cust_pay_batch->amount); # DB = debit push @fields, 'DB', $trans_code, $process_date; diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm index 7026205a5..7eda7e02c 100644 --- a/FS/FS/svc_IP_Mixin.pm +++ b/FS/FS/svc_IP_Mixin.pm @@ -93,7 +93,7 @@ sub _used_addresses { # in use, yes? my %hash = ( $ip_field => { op => '!=', value => '' } ); - $hash{'blocknum'} = $block->blocknum if $block; + #$hash{'blocknum'} = $block->blocknum if $block; $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude; map { $_->NetAddr->addr } qsearch($class->table, \%hash); } diff --git a/FS/FS/svc_Radius_Mixin.pm b/FS/FS/svc_Radius_Mixin.pm index ac97eab58..544c7e958 100644 --- a/FS/FS/svc_Radius_Mixin.pm +++ b/FS/FS/svc_Radius_Mixin.pm @@ -68,7 +68,8 @@ sub replace { $old->usergroup; # make sure this is cached for exports - my $error = $new->process_m2m( + my $error = $new->check # make sure fixed fields are set before process_m2m + || $new->process_m2m( 'link_table' => 'radius_usergroup', 'target_table' => 'radius_group', 'params' => $new->usergroup, diff --git a/FS/MANIFEST b/FS/MANIFEST index 9c444be58..f954fe8dd 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -675,3 +675,7 @@ FS/svc_export_machine.pm t/svc_export_machine.t FS/GeocodeCache.pm t/GeocodeCache.t +FS/log.pm +t/log.t +FS/log_context.pm +t/log_context.t diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 8e8ae4ff9..ac93aaf2f 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -4,6 +4,7 @@ use strict; use Getopt::Std; use FS::UID qw(adminsuidsetup); use FS::Conf; +use FS::Log; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); @@ -11,6 +12,8 @@ getopts("p:a:d:vl:sy:nmrkg:o", \%opt); my $user = shift or die &usage; adminsuidsetup $user; +my $log = FS::Log->new('daily'); +$log->info('start'); #you can skip this by not having a NetworkMonitoringSystem configured use FS::Cron::nms_report qw(nms_report); @@ -74,6 +77,8 @@ unlink <${deldir}.CGItemp*>; use FS::Cron::backup qw(backup); backup(); +$log->info('finish'); + ### # subroutines ### @@ -138,7 +143,7 @@ the bill and collect methods of a cust_main object. See L. -l: debugging level - -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. + -m: Multi-process mode uses the job queue for multi-process and/or multi-machine billing. -r: Multi-process mode dry run option diff --git a/FS/bin/freeside-ipifony-download b/FS/bin/freeside-ipifony-download new file mode 100644 index 000000000..e893326e2 --- /dev/null +++ b/FS/bin/freeside-ipifony-download @@ -0,0 +1,240 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Format qw(time2str); +use File::Temp qw(tempdir); +use Net::SFTP::Foreign; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use FS::Conf; +use Text::CSV; + +my %opt; +getopts('va:P:C:', \%opt); + +#$Net::SFTP::Foreign::debug = -1; +sub HELP_MESSAGE { ' + Usage: + freeside-ipifony-download + [ -v ] + [ -a archivedir ] + [ -P port ] + [ -C category ] + freesideuser sftpuser@hostname[:path] +' } + +my @fields = ( + 'custnum', + 'date_desc', + 'quantity', + 'amount', + 'classname', +); + +my $user = shift or die &HELP_MESSAGE; +adminsuidsetup $user; + +# for statistics +my $num_charges = 0; +my $num_errors = 0; +my $sum_charges = 0; +# cache classnums +my %classnum_of; + +if ( $opt{a} ) { + die "no such directory: $opt{a}\n" + unless -d $opt{a}; + die "archive directory $opt{a} is not writable by the freeside user\n" + unless -w $opt{a}; +} + +my $categorynum = ''; +if ( $opt{C} ) { + # find this category (don't auto-create it, it should exist already) + my $category = qsearchs('pkg_category', { categoryname => $opt{C} }); + if (!defined($category)) { + die "Package category '$opt{C}' does not exist.\n"; + } + $categorynum = $category->categorynum; +} + +#my $tmpdir = File::Temp->newdir(); +my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere? + +my $host = shift + or die &HELP_MESSAGE; +my ($sftpuser, $path); +$host =~ s/^(.+)\@//; +$sftpuser = $1 || $ENV{USER}; +$host =~ s/:(.*)//; +$path = $1; + +my $port = 22; +if ( $opt{P} =~ /^(\d+)$/ ) { + $port = $1; +} + +# for now assume SFTP download as the only method +print STDERR "Connecting to $sftpuser\@$host...\n" if $opt{v}; + +my $sftp = Net::SFTP::Foreign->new( + host => $host, + user => $sftpuser, + port => $port, + # for now we don't support passwords. use authorized_keys. + timeout => 30, + more => ($opt{v} ? '-v' : ''), +); +die "failed to connect to '$sftpuser\@$host'\n(".$sftp->error.")\n" + if $sftp->error; + +$sftp->setcwd($path) if $path; + +my $files = $sftp->ls('.', wanted => qr/\.csv$/, names_only => 1); +if (!@$files) { + print STDERR "No charge files found.\n" if $opt{v}; + exit(-1); +} +FILE: foreach my $filename (@$files) { + print STDERR "Retrieving $filename\n" if $opt{v}; + $sftp->get("$filename", "$tmpdir/$filename"); + if($sftp->error) { + warn "failed to download $filename\n"; + next FILE; + } + + # make sure server archive dir exists + if ( !$sftp->stat('Archive') ) { + print STDERR "Creating $path/Archive\n" if $opt{v}; + $sftp->mkdir('Archive'); + if($sftp->error) { + # something is seriously wrong + die "failed to create archive directory on server:\n".$sftp->error."\n"; + } + } + #move to server archive dir + $sftp->rename("$filename", "Archive/$filename"); + if($sftp->error) { + warn "failed to archive $filename on server:\n".$sftp->error."\n"; + } # process it anyway, I guess/ + + #copy to local archive dir + if ( $opt{a} ) { + print STDERR "Copying $tmpdir/$filename to archive dir $opt{a}\n" + if $opt{v}; + copy("$tmpdir/$filename", $opt{a}); + warn "failed to copy $tmpdir/$filename to $opt{a}: $!" if $!; + } + + open my $fh, "<$tmpdir/$filename"; + my $header = <$fh>; + if ($header !~ /^cust_id/) { + warn "warning: $filename has incorrect header row:\n$header\n"; + # but try anyway + } + my $csv = Text::CSV->new; # orthodox CSV + my %hash; + while (my $line = <$fh>) { + $csv->parse($line) or do { + warn "can't parse $filename: ".$csv->error_input."\n"; + next FILE; + }; + @hash{@fields} = $csv->fields(); + my $cust_main = FS::cust_main->by_key($hash{custnum}); + if (!$cust_main) { + warn "customer #$hash{custnum} not found\n"; + next; + } + print STDERR "Found customer #$hash{custnum}: ".$cust_main->name."\n" + if $opt{v}; + + # construct arguments for $cust_main->charge + my %opt = ( + amount => $hash{amount}, + quantity => $hash{quantity}, + start_date => $cust_main->next_bill_date, + pkg => $hash{date_desc}, + ); + if (my $classname = $hash{classname}) { + if (!exists($classnum_of{$classname}) ) { + # then look it up + my $pkg_class = qsearchs('pkg_class', { + classname => $classname, + categorynum => $categorynum, + }); + if (!defined($pkg_class)) { + # then create it + $pkg_class = FS::pkg_class->new({ + classname => $classname, + categorynum => $categorynum, + }); + my $error = $pkg_class->insert; + die "Error creating package class for product code '$classname':\n". + "$error\n" + if $error; + } + + $classnum_of{$classname} = $pkg_class->classnum; + } + $opt{classnum} = $classnum_of{$classname}; + } + # XXX what's the tax status of these charges? + print STDERR " Charging $hash{amount}\n" + if $opt{v}; + my $error = $cust_main->charge(\%opt); + if ($error) { + warn "Error creating charge: $error" if $error; + $num_errors++; + } else { + $num_charges++; + $sum_charges += $hash{amount}; + } + } #while $line + close $fh; +} #FILE + +if ($opt{v}) { + print STDERR " +Finished! + Processed files: @$files + Created charges: $num_charges + Sum of charges: \$".sprintf('%0.2f', $sum_charges)." + Errors: $num_errors +"; +} + +=head1 NAME + +freeside-eftca-download - Retrieve payment batch responses from EFT Canada. + +=head1 SYNOPSIS + + freeside-eftca-download [ -v ] [ -a archivedir ] user + +=head1 DESCRIPTION + +Command line tool to download returned payment reports from the EFT Canada +gateway and void the returned payments. Uses the login and password from +'batchconfig-eft_canada'. + +-v: Be verbose. + +-a directory: Archive response files in the provided directory. + +user: freeside username + +=head1 BUGS + +You need to manually SFTP to ftp.eftcanada.com from the freeside account +and accept their key before running this script. + +=head1 SEE ALSO + +L + +=cut + +1; + diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly index 0d6ea14a2..69502a01d 100755 --- a/FS/bin/freeside-monthly +++ b/FS/bin/freeside-monthly @@ -7,7 +7,7 @@ use FS::UID qw(adminsuidsetup); &untaint_argv; #what it sounds like (eww) #use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); use vars qw(%opt); -getopts("p:a:d:vsy:", \%opt); +getopts("p:a:d:vsy:m", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -72,6 +72,8 @@ the bill and collect methods of a cust_main object. See L. -v: enable debugging + -m: Experimental multi-process mode (delay upload jobs until billing jobs complete) + user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 756b699d4..2fd80255e 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -11,6 +11,7 @@ use FS::Conf; use FS::Record qw(qsearch); use FS::queue; use FS::queue_depend; +use FS::Log; # no autoloading for non-FS classes... use Net::SSH 0.07; @@ -45,6 +46,7 @@ while ( $@ ) { } } +my $log = FS::Log->new('queue'); logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc ); warn "completing daemonization (detaching))\n" if $DEBUG; @@ -135,6 +137,8 @@ while (1) { foreach my $job ( @jobs ) { + $log->debug('locking queue job', object => $job); + my %hash = $job->hash; $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); @@ -186,7 +190,7 @@ while (1) { dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); #auto-use classes... - if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg)::\w+)::/ + if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg|Cron)::\w+)::/ || $ljob->job =~ /(FS::\w+)::/ ) { @@ -205,6 +209,8 @@ while (1) { } my $eval = "&". $ljob->job. '(@args);'; + # don't put @args in the log, may expose passwords + $log->info('starting job ('.$ljob->job.')'); warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; eval $eval; #throw away return value? suppose so if ( $@ ) { diff --git a/FS/t/log.t b/FS/t/log.t new file mode 100644 index 000000000..42c604b88 --- /dev/null +++ b/FS/t/log.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::log; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/log_context.t b/FS/t/log_context.t new file mode 100644 index 000000000..57c3b340b --- /dev/null +++ b/FS/t/log_context.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::log_context; +$loaded=1; +print "ok 1\n"; diff --git a/fs_selfservice/FS-SelfService/cgi/promocode.html b/fs_selfservice/FS-SelfService/cgi/promocode.html index f8ee7f6eb..0962d44b5 100644 --- a/fs_selfservice/FS-SelfService/cgi/promocode.html +++ b/fs_selfservice/FS-SelfService/cgi/promocode.html @@ -1,13 +1,8 @@ ISP Signup ISP Signup - promotional code

    - -
    + Enter promotional code - +
    diff --git a/fs_selfservice/FS-SelfService/cgi/selfservice.cgi b/fs_selfservice/FS-SelfService/cgi/selfservice.cgi index 61361b8ee..de0ab1a76 100755 --- a/fs_selfservice/FS-SelfService/cgi/selfservice.cgi +++ b/fs_selfservice/FS-SelfService/cgi/selfservice.cgi @@ -843,7 +843,7 @@ sub real_port_graph { 'session_id' => $session_id, 'svcnum' => $svcnum, 'beginning' => str2time($cgi->param('start')." 00:00:00"), - 'ending' => str2time($cgi->param('end')." 23:59:59"), + 'ending' => str2time($cgi->param('end') ." 23:59:59"), ); my @usage = @{$res->{'usage'}}; my $png = $usage[0]->{'png'}; diff --git a/htetc/freeside-base2.conf b/htetc/freeside-base2.conf index dcf5efa3f..49b4a243d 100644 --- a/htetc/freeside-base2.conf +++ b/htetc/freeside-base2.conf @@ -6,6 +6,8 @@ PerlModule HTML::Mason PerlSetVar MasonArgsMethod CGI PerlModule HTML::Mason::ApacheHandler +PerlChildInitHandler "sub { srand }" + PerlRequire "%%%MASON_HANDLER%%%" #Locale::SubCountry diff --git a/httemplate/browse/agent_type.cgi b/httemplate/browse/agent_type.cgi index 1959302d2..7711dccf7 100755 --- a/httemplate/browse/agent_type.cgi +++ b/httemplate/browse/agent_type.cgi @@ -44,9 +44,9 @@ my $agent_type = shift; [ { #'data' => $part_pkg->pkg. ' - '. $part_pkg->comment, - 'data' => $type_pkgs->pkg. ' - '. + 'data' => encode_entities($type_pkgs->pkg). ' - '. ( $type_pkgs->custom ? '(CUSTOM) ' : '' ). - $type_pkgs->comment, + encode_entities($type_pkgs->comment), 'align' => 'left', 'link' => $p. 'edit/part_pkg.cgi?'. $type_pkgs->pkgpart, }, diff --git a/httemplate/browse/part_export.cgi b/httemplate/browse/part_export.cgi index b7ecc00a6..91238a0fd 100755 --- a/httemplate/browse/part_export.cgi +++ b/httemplate/browse/part_export.cgi @@ -43,14 +43,56 @@ function part_export_areyousure(href) { <% itable() %> % my %opt = $part_export->options; -% foreach my $opt ( keys %opt ) { +% my $defs = $part_export->info->{options}; +% my %multiples; +% foreach my $opt (keys %$defs) { # is a Tie::IxHash +% my $group = $defs->{$opt}->{multiple}; +% if ( $group ) { +% my @values = split("\n", $opt{$opt}); +% $multiples{$group} ||= []; +% push @{ $multiples{$group} }, [ $opt, @values ] if @values; +% delete $opt{$opt}; +% } elsif (length($opt{$opt})) { # the normal case +%# foreach my $opt ( keys %opt ) { <% $opt %>:  <% encode_entities($opt{$opt}) %> -% } - +% delete $opt{$opt}; +% } +% } +% # now any that are somehow not in the options list +% foreach my $opt (keys %opt) { +% if ( length($opt{$opt}) ) { + + <% $opt %>:  + <% encode_entities($opt{$opt}) %> + +% } +% } +% # now show any multiple-option groups +% foreach (sort keys %multiples) { +% my $set = $multiples{$_}; + + +% foreach my $col (@$set) { + +% } + +% while ( 1 ) { + +% my $end = 1; +% foreach my $col (@$set) { + +% $end = 0 if @$col; +% } + +% last if $end; +% } +
    <% shift @$col %>
    <% shift @$col %>
    +% } #foreach keys %multiples + diff --git a/httemplate/edit/agent_type.cgi b/httemplate/edit/agent_type.cgi index 8a6fbc255..b75757fb1 100755 --- a/httemplate/edit/agent_type.cgi +++ b/httemplate/edit/agent_type.cgi @@ -20,7 +20,7 @@ Select which packages agents of this type may sell to customers
    'source_obj' => $agent_type, 'link_table' => 'type_pkgs', 'target_table' => 'part_pkg', - 'name_callback' => sub { $_[0]->pkg_comment(nopkgpart => 1); }, + 'name_callback' => sub { encode_entities( $_[0]->pkg_comment(nopkgpart => 1) ); }, 'target_link' => $p.'edit/part_pkg.cgi?', 'disable-able' => 1, diff --git a/httemplate/edit/cdr_type.cgi b/httemplate/edit/cdr_type.cgi index 5d2c66216..c69610607 100644 --- a/httemplate/edit/cdr_type.cgi +++ b/httemplate/edit/cdr_type.cgi @@ -7,11 +7,24 @@ calls and SMS messages. Each CDR type must have a set of rates configured in the rate tables.
    "> -<% include('/elements/auto-table.html', - 'header' => [ 'Type#', 'Name' ], - 'fields' => [ qw( cdrtypenum cdrtypename ) ], + + + + + + + + + +<& /elements/auto-table.html, + 'template_row' => 'cdr_template', 'data' => \@data, - ) %> +&> +
    Type#Name
    + + + +

    <% include('/elements/footer.html') %> <%init> @@ -20,7 +33,6 @@ die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); my @data = ( - map { [ $_->cdrtypenum, $_->cdrtypename ] } qsearch({ 'table' => 'cdr_type', 'hashref' => {}, diff --git a/httemplate/edit/credit-cust_bill_pkg.html b/httemplate/edit/credit-cust_bill_pkg.html new file mode 100644 index 000000000..e317936b3 --- /dev/null +++ b/httemplate/edit/credit-cust_bill_pkg.html @@ -0,0 +1,249 @@ +<& /elements/header-popup.html, 'Credit line items' &> + +
    + + + + + + +% my $old_invnum = 0; +%# foreach my $cust_bill_pkg ( @cust_bill_pkg ) { +% foreach my $item ( @items ) { +% my( $setuprecur, $cust_bill_pkg ) = @$item; + +% my $method = $setuprecur eq 'setup' ? 'setup' : 'recur'; +% my $amount = $cust_bill_pkg->$method(); +% my $credited = $cust_bill_pkg->credited('', '', 'setuprecur'=>$method); +% $amount -= $credited; +% $amount = sprintf('%.2f', $amount); +% next unless $amount > 0; + +% if ( $cust_bill_pkg->invnum ne $old_invnum ) { + + +% $old_invnum = $cust_bill_pkg->invnum; +% } + + + + +%# show one-time/setup vs recur vs usage? + + + +% } + + + + + + + + + + + + + + + + + +
     
    Invoice #<% $cust_bill_pkg->invnum %> - <% time2str($date_format, $cust_bill_pkg->cust_bill->_date) %>
    + + <% $cust_bill_pkg->desc |h %><% $money_char. $amount %>
     
    Subtotal: <% $money_char %><% sprintf('%.2f', 0) %>
    Taxes: <% $money_char %><% sprintf('%.2f', 0) %>
    Total credit amount: + <% $money_char %><% sprintf('%.2f', 0) %> +
    + + + +<& /elements/tr-select-reason.html, + 'field' => 'reasonnum', + 'reason_class' => 'R', + #XXX reconcile both this and show_taxes wanteding to enable this + 'control_button' => "document.getElementById('credit_button')", + 'cgi' => $cgi, +&> + + + + + + +
    <% mt('Additional info') |h %> + +
    + +
    + + +
    + +<% include( '/elements/xmlhttp.html', + 'url' => $p.'misc/xmlhttp-cust_bill_pkg-calculate_taxes.html', + 'subs' => [ 'calculate_taxes' ], + ) +%> + + +<%init> + +my $curuser = $FS::CurrentUser::CurrentUser; +die "access denied" unless $curuser->access_right('Post credit'); + +#a tiny bit of false laziness w/search/cust_bill_pkg.cgi, but we're pretty +# specialized and a piece of UI, not a report +#slightly more false laziness w/httemplate/edit/elements/ApplicationCommon.html +# show_taxes & calc_total here/do_calculate_tax there + +my $conf = new FS::Conf; +my $money_char = $conf->config('money_char') || '$'; +my $date_format = $conf->config('date_format') || '%m/%d/%Y'; + +$cgi->param('custnum') =~ /^(\d+)$/ or die 'illegal custnum'; +my $custnum = $1; + +my $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $custnum }, + 'extra_sql' => ' AND '. $curuser->agentnums_sql, +}) or die 'unknown customer'; + +my @cust_bill_pkg = qsearch({ + 'select' => 'cust_bill_pkg.*', + 'table' => 'cust_bill_pkg', + 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)', + 'extra_sql' => "WHERE custnum = $custnum AND pkgnum != 0", + 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC', +}); + +my @items = map { my %hash = $_->disintegrate; + map [ $_, $hash{$_} ], + keys(%hash); + } + @cust_bill_pkg; + +#omit line items which have been previously credited? would be nice + + diff --git a/httemplate/edit/cust_credit.cgi b/httemplate/edit/cust_credit.cgi index 6e8a9c989..4dba1e769 100755 --- a/httemplate/edit/cust_credit.cgi +++ b/httemplate/edit/cust_credit.cgi @@ -34,6 +34,7 @@ + % if ( $conf->exists('credits-auto-apply-disable') ) { diff --git a/httemplate/edit/elements/part_export/broadband_snmp.html b/httemplate/edit/elements/part_export/broadband_snmp.html new file mode 100644 index 000000000..4c0367c5a --- /dev/null +++ b/httemplate/edit/elements/part_export/broadband_snmp.html @@ -0,0 +1,101 @@ +<%doc> + +<& head.html, %opt &> + +<& /elements/tr-select.html, + label => 'SNMP version', + field => 'version', + options => [ '', 'v1', 'v2c' ], + labels => { v1 => '1', v2c => '2c' }, + curr_value => $part_export->option('version') &> +<& /elements/tr-input-text.html, + label => 'Community', + field => 'community', + curr_value => $part_export->option('community'), +&> +<& /elements/tr-checkbox.html, + label => 'Send IP address changes to new address', + field => 'ip_addr_change_to_new', + value => 1, + curr_value => $part_export->option('ip_addr_change_to_new'), +&> +<& /elements/tr-input-text.html, + label => 'Timeout (seconds)', + field => 'timeout', + curr_value => $part_export->option('timeout'), +&> + + + + + + + + + + + + + + + + +<& /elements/auto-table.html, + template_row => 'mytemplate', + fieldorder => ['action', 'oid', 'datatype', 'value'], + data => \@data, +&> + +<& foot.html, %opt &> +<%init> +my %opt = @_; +my $part_export = $opt{part_export} || FS::part_export->new; + +my @actions = split("\n", $part_export->option('action')); +my @oids = split("\n", $part_export->option('oid')); +my @types = split("\n", $part_export->option('datatype')); +my @values = split("\n", $part_export->option('value')); + +my @data; +while (@actions or @oids or @values) { + my @thisrow = (shift(@actions), shift(@oids), shift(@types), shift(@values)); + push @data, \@thisrow if grep length($_), @thisrow; +} + +my $popup_name = 'popup-'.time."-$$-".rand() * 2**32; + diff --git a/httemplate/edit/elements/part_export/foot.html b/httemplate/edit/elements/part_export/foot.html new file mode 100644 index 000000000..9cb8073ce --- /dev/null +++ b/httemplate/edit/elements/part_export/foot.html @@ -0,0 +1,6 @@ +
    ActionObjectTypeValue
    + + + + + + + +
    + + +<%init> +my %opt = @_; + diff --git a/httemplate/edit/elements/part_export/head.html b/httemplate/edit/elements/part_export/head.html new file mode 100644 index 000000000..cb0ab894a --- /dev/null +++ b/httemplate/edit/elements/part_export/head.html @@ -0,0 +1,19 @@ +% if ( $export_info->{no_machine} ) { + + +% } else { +% # clone this from edit/part_export.cgi if this case ever gets used +% } + +<% ntable('cccccc', 2) %> + + <% emt('Description') %> + <% $notes %> + +<%init> +my %opt = @_; +my $layer = $opt{layer}; +my $part_export = $opt{part_export}; +my $export_info = $opt{export_info}; +my $notes = $opt{notes} || $export_info->{notes}; + diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi index 0407ee77b..4dd253be8 100644 --- a/httemplate/edit/part_export.cgi +++ b/httemplate/edit/part_export.cgi @@ -62,6 +62,15 @@ my $widget = new HTML::Widgets::SelectLayers( 'html_between' => "\n", 'layer_callback' => sub { my $layer = shift; + # create 'config_element' to generate the whole layer with a Mason component + if ( my $include = $exports->{$layer}{config_element} ) { + # might need to adjust the scope of this at some point + return $m->scomp($include, + part_export => $part_export, + layer => $layer, + export_info => $exports->{$layer} + ); + } my $html = qq!!. ntable("#cccccc",2); diff --git a/httemplate/edit/part_pkg.cgi b/httemplate/edit/part_pkg.cgi index f3ad8f52d..50aeb4595 100755 --- a/httemplate/edit/part_pkg.cgi +++ b/httemplate/edit/part_pkg.cgi @@ -622,23 +622,23 @@ END my $warning = 'Changing the setup or recurring fee will create a new package definition. '. 'Continue?'; - + +$javascript .= "function confirm_submit(f) {"; if ( $conf->exists('part_pkg-lineage') ) { $javascript .= " - function confirm_submit(f) { - - var fields = Array('setup_fee','recur_fee'); - for(var i=0; i < fields.length; i++) { - if ( f[fields[i]].value != f[fields[i]].defaultValue ) { - return confirm('$warning'); - } - } - return true; + + var fields = Array('setup_fee','recur_fee'); + for(var i=0; i < fields.length; i++) { + if ( f[fields[i]].value != f[fields[i]].defaultValue ) { + return confirm('$warning'); + } } "; } - -$javascript .= ''; +$javascript .= " + return true; +} +"; tie my %plans, 'Tie::IxHash', %{ FS::part_pkg::plan_info() }; diff --git a/httemplate/edit/process/cdr_type.cgi b/httemplate/edit/process/cdr_type.cgi index b661de75d..ba9881dc4 100644 --- a/httemplate/edit/process/cdr_type.cgi +++ b/httemplate/edit/process/cdr_type.cgi @@ -10,7 +10,6 @@ die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); my %vars = $cgi->Vars; -warn Dumper(\%vars)."\n"; my %old = map { $_->cdrtypenum => $_ } qsearch('cdr_type', {}); diff --git a/httemplate/edit/process/credit-cust_bill_pkg.html b/httemplate/edit/process/credit-cust_bill_pkg.html new file mode 100644 index 000000000..8b2f3f3ea --- /dev/null +++ b/httemplate/edit/process/credit-cust_bill_pkg.html @@ -0,0 +1,44 @@ +%if ($error) { +% errorpage_popup($error); #XXX redirect back for correction... +%} else { +<& /elements/header-popup.html, 'Credit successful' &> + + +% } +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Post credit'); + +my @billpkgnum_setuprecurs = + map { $_ =~ /^billpkgnum(\d+\-\w*)$/ or die 'gm#23'; $1; } + grep { $_ =~ /^billpkgnum\d+\-\w*$/ && $cgi->param($_) } $cgi->param; + +my @billpkgnums = (); +my @setuprecurs = (); +my @amounts = (); +foreach my $billpkgnum_setuprecur (@billpkgnum_setuprecurs) { + my $amount = $cgi->param("billpkgnum$billpkgnum_setuprecur"); + my( $billpkgnum, $setuprecur ) = split('-', $billpkgnum_setuprecur); + push @billpkgnums, $billpkgnum; + push @setuprecurs, $setuprecur; + push @amounts, $amount; +} + +my $error = FS::cust_credit->credit_lineitems( + #the lineitems to credit + 'billpkgnums' => \@billpkgnums, + 'setuprecurs' => \@setuprecurs, + 'amounts' => \@amounts, + + #the credit + 'newreasonnum' => scalar($cgi->param('newreasonnum')), + 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')), + map { $_ => scalar($cgi->param($_)) } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum +); + + diff --git a/httemplate/edit/process/cust_credit.cgi b/httemplate/edit/process/cust_credit.cgi index 776112ac0..245f31af7 100755 --- a/httemplate/edit/process/cust_credit.cgi +++ b/httemplate/edit/process/cust_credit.cgi @@ -15,7 +15,7 @@ % % $dbh->commit or die $dbh->errstr if $oldAutoCommit; % -<% header(emt('Credit sucessful')) %> +<% header(emt('Credit successful')) %> @@ -27,7 +27,7 @@ die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Post credit'); -$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; +$cgi->param('custnum') =~ /^(\d+)$/ or die "Illegal custnum!"; my $custnum = $1; $cgi->param('reasonnum') =~ /^(-?\d+)$/ or die "Illegal reasonnum"; diff --git a/httemplate/edit/process/part_export.cgi b/httemplate/edit/process/part_export.cgi index 6432d6b15..bcb9c0df1 100644 --- a/httemplate/edit/process/part_export.cgi +++ b/httemplate/edit/process/part_export.cgi @@ -13,15 +13,40 @@ my $exportnum = $cgi->param('exportnum'); my $old = qsearchs('part_export', { 'exportnum'=>$exportnum } ) if $exportnum; +my %vars = $cgi->Vars; #fixup options #warn join('-', split(',',$cgi->param('options'))); my %options = map { - my @values = $cgi->param($_); - my $value = scalar(@values) > 1 ? join (' ', @values) : $values[0]; + my $value = $vars{$_}; + $value =~ s/\0/ /g; # deal with multivalued options $value =~ s/\r\n/\n/g; #browsers? (textarea) $_ => $value; } split(',', $cgi->param('options')); +# deal with multiline options +# %vars should never contain incomplete rows, but just in case it does, +# we make a list of all the row indices that contain values, and +# then write a line in each option for each row, even if it's empty. +# This ensures that all values with the same row index line up. +my %optionrows; +foreach my $option (split(',', $cgi->param('multi_options'))) { + $optionrows{$option} = {}; + my %values; # bear with me + for (keys %vars) { + /^$option(\d+)/ or next; + $optionrows{$option}{$1} = $vars{$option.$1}; + $optionrows{_ALL_}{$1} = 1 if length($vars{$option.$1}); + } +} +foreach my $option (split(',', $cgi->param('multi_options'))) { + my $value = ''; + foreach my $row (sort keys %{$optionrows{_ALL_}}) { + $value .= ($optionrows{$option}{$row} || '') . "\n"; + } + chomp($value); + $options{$option} = $value; +} + my $new = new FS::part_export ( { map { $_, scalar($cgi->param($_)); diff --git a/httemplate/edit/rate_time.cgi b/httemplate/edit/rate_time.cgi index 7ee39efca..9e6b8736c 100644 --- a/httemplate/edit/rate_time.cgi +++ b/httemplate/edit/rate_time.cgi @@ -15,12 +15,34 @@ -<% include('/elements/auto-table.html', - 'header' => [ '', 'Start','','', '','End','','' ], - 'fields' => [ qw(sd sh sm sa ed eh em ea) ], - 'select' => [ ($day, $hour, $min, $ampm) x 2 ], - 'data' => \@data, - ) %> + + + + + + +% for my $pre (qw(s e)) { +% for my $f (qw(d h m a)) { # day, hour, minute, am/pm + +% } #$f +% } #$pre + +<& /elements/auto-table.html, + 'template_row' => 'mytemplate', + 'data' => \@data, + 'fieldorder' => [qw(sd sh sm sa ed eh em ea)], +&> +
    StartEnd
    + +

    @@ -42,7 +64,12 @@ my $day = [ 0 => 'Sun', my $hour = [ map( {$_, sprintf('%02d',$_) } 12, 1..11 )]; my $min = [ map( {$_, sprintf('%02d',$_) } 0,30 )]; my $ampm = [ 0 => 'AM', 1 => 'PM' ]; - +my %choices = ( + 'd' => $day, + 'h' => $hour, + 'm' => $min, + 'a' => $ampm, +); if($ratetimenum) { $action = 'Edit'; $rate_time = qsearchs('rate_time', {ratetimenum => $ratetimenum}) diff --git a/httemplate/elements/auto-table.html b/httemplate/elements/auto-table.html index 49222745a..9aff94e67 100644 --- a/httemplate/elements/auto-table.html +++ b/httemplate/elements/auto-table.html @@ -1,166 +1,180 @@ <%doc> - -Example: -<% include('/elements/auto-table.html', - - ### - # required - ### - - 'header' => [ '#', 'Item', 'Amount' ], - 'fields' => [ 'id', 'name', 'amount' ], - - ### - # highly recommended - ### - - 'size' => [ 4, 12, 8 ], - 'maxl' => [ 4, 12, 8 ], - 'align' => [ 'right', 'left', 'right' ], - - ### - # optional - ### - - 'data' => [ [ 1, 'Widget', 25 ], - [ 12, 'Super Widget, 7 ] ], - #or - 'records' => [ qsearch('item', { } ) ], - # or any other array of FS::Record objects - - 'select' => [ '', - [ 1 => 'option 1', - 2 => 'option 2', ... - ], # options for second field - '' ], - - 'prefix' => 'mytable_', -) %> - -Values will be passed through as "mytable_id1", etc. +(within a form) + + + + + + + + + ... + +
    Field 1Field 2
    +<& /elements/auto-table.html, + table => 'mytable', + template_row = 'mytemplate', + rows => [ + { field1 => 'foo', field2 => 'CA', ... }, + { field1 => 'bar', field2 => 'TX', ... }, ... + ], +&> + + or if you prefer: +... + fieldorder => [ 'field1', 'field2', ... ], + rows => [ + [ 'foo', 'CA' ], + [ 'bar', 'TX' ], + ], + +In the process/ handler, something like: +my @rows; +my %vars = $cgi->Vars; +for my $k ( keys %vars ) { + $k =~ /^${pre}magic(\d+)$/ or next; + my $rownum = $1; + # find all submitted names ending in this rownum + my %thisrow = + map { $_ => $vars{$_} } + grep /^(.*[\d])$rownum$/, keys %vars; + $thisrow->{num} = delete $thisrow{"${pre}magic$rownum"}; + push @rows, $thisrow; +} - - - -% foreach (@header) { - -% } - -% my $row = 0; -% for ( $row = 0; $row < scalar @data; $row++ ) { - -% my $col = 0; -% for ( $col = 0; $col < scalar @fields; $col++ ) { -% my $id = $prefix . $fields[$col]; -% # don't suffix rownum in the final, blank row -% $id .= $row if $row < (scalar @data) - 1; - -% } -% } - - -% } -
    <% $_ %>
    -% my @o = @{ $select[$col] }; -% if( @o ) { - -% } -% else { - - MAXLENGTH = <% $maxl[$col] %> - STYLE = "text-align:<% $align[$col] %>" - VALUE = "<% $data[$row][$col] %>" -% if( $opt{'autoadd'} ) { - onchange = "possiblyAddRow(this);" -% } - > - - " - ALT = "X" - onclick = "deleteRow(this);" - > -
    -% if( !$opt{'autoadd'} ) { -
    -% } - - + <%$pre%>addRow(); +} +<%$pre%>init(); + <%init> my %opt = @_; - -my @header = @{ $opt{'header'} }; -my @fields = @{ $opt{'fields'} }; -my @data = (); -if($opt{'data'}) { - @data = @{ $opt{'data'} }; -} -elsif($opt{'records'}) { - foreach my $rec (@{ $opt{'records'} }) { - push @data, [ map { $rec->getfield($_) } @fields ]; +my $pre = ''; +$pre = $opt{'table'} . '_' if $opt{'table'}; +my $template_row = $opt{'template_row'} + or die "auto-table requires template_row\n"; # a DOM id + +# rows that we will preload, as hashrefs of name => value +my @rows = @{ $opt{'data'} || [] }; +foreach (@rows) { + # allow an array of FS::Record objects to be passed + if ( blessed($_) and $_->isa('FS::Record') ) { + $_ = $_->hashref; } } -# else @data = (); -push @data, [ map {''} @fields ]; # make a blank row - -my $prefix = $opt{'prefix'}; -my @size = $opt{'size'} ? @{ $opt{'size'} } : (map {16} @fields); -my @maxl = $opt{'maxl'} ? @{ $opt{'maxl'} } : @size; -my @align = $opt{'align'} ? @{ $opt{'align'} } : (map {'right'} @fields); -my @select = @{ $opt{'select'} || [] }; -foreach (0..scalar(@fields)-1) { - $select[$_] ||= []; -} +my $fieldorder = $opt{'fieldorder'} || []; diff --git a/httemplate/elements/contact.html b/httemplate/elements/contact.html index b3e535344..490ba2303 100644 --- a/httemplate/elements/contact.html +++ b/httemplate/elements/contact.html @@ -15,7 +15,7 @@ <% ($contact_class->classnum == $classnum) ? 'SELECTED' : '' %> ><% $contact_class->classname |h %> % } -
    Type % } else { diff --git a/httemplate/elements/location.html b/httemplate/elements/location.html index 0f844531d..873fe1621 100644 --- a/httemplate/elements/location.html +++ b/httemplate/elements/location.html @@ -179,7 +179,7 @@ Example: % if ( $opt{enable_coords} ) { - <% mt('Latitude') |h %> + <% mt('Latitude') |h %> [ \%report_invoices_open, 'Open invoices' ], 'All invoices' => [ $fsurl. 'search/cust_bill.html?date', 'List all invoices' ], 'Advanced invoice reports' => [ $fsurl.'search/report_cust_bill.html', 'by agent, date range, etc.' ], + 'separator' => '', + 'Line items' => [ $fsurl. 'search/report_cust_bill_pkg.html', 'Individual line item detail' ], ; tie my %report_discounts, 'Tie::IxHash', @@ -231,13 +233,13 @@ foreach my $svcdb ( FS::part_svc->svc_tables() ) { } tie my %report_packages, 'Tie::IxHash'; -if ( $curuser->access_right('Edit package definitions') - || $curuser->access_right('Edit global package definitions') - ) -{ - $report_packages{'Package definitions (by # active)'} = [ $fsurl.'browse/part_pkg.cgi?active=1', 'Package definitions by number of active packages' ]; - $report_packages{'separator'} = ''; -} +$report_packages{'Package definitions (by # active)'} = [ $fsurl.'browse/part_pkg.cgi?active=1', 'Package definitions by number of active packages' ] + if $curuser->access_right('Edit package definitions') + || $curuser->access_right('Edit global package definitions'); +$report_packages{'Package Costs Report'} = [ $fsurl.'graph/report_cust_pkg_cost.html', 'Package setup and recurring costs graph' ] + if $curuser->access_right('Financial reports'); +$report_packages{'separator'} = '' + if keys %report_packages; if ( $curuser->access_right('Financial reports') ) { $report_packages{'Package churn'} = [ $fsurl.'graph/report_cust_pkg.html', 'Orders, suspensions and cancellations summary graph' ]; $report_packages{'separator2'} = ''; @@ -292,6 +294,11 @@ tie my %report_ticketing, 'Tie::IxHash', 'Advanced ticket reports' => [ $fsurl.'rt/Search/Build.html?NewQuery=1', 'List tickets by any criteria' ], ; +tie my %report_employees, 'Tie::IxHash', + 'Employee Commission Report' => [ $fsurl.'search/report_employee_commission.html', '' ], + 'Employee Audit Report' => [ $fsurl.'search/report_employee_audit.html', 'Employee audit report' ], +; + tie my %report_bill_event, 'Tie::IxHash', 'All billing events' => [ $fsurl.'search/report_cust_event.html', 'All billing events for a date range' ], 'Billing event errors' => [ $fsurl.'search/report_cust_event.html?failed=1', 'Failed credit cards, processor or printer problems, etc.' ], @@ -313,22 +320,32 @@ $report_payments{'Unapplied Payment Aging'} = [ $fsurl.'search/report_unapplied_ $report_payments{'Deleted Payments / Payment history table'} = [ $fsurl.'search/report_h_cust_pay.html', 'Deleted payments / payment history table' ] if $conf->exists('payment-history-report'); +tie my %report_credits, 'Tie::IxHash', + 'Credit Report' => [ $fsurl.'search/report_cust_credit.html', 'Credit report (by employee and/or date range)' ], + 'Credit application detail' => [ $fsurl.'search/report_cust_credit_bill_pkg.html', 'Line item application detail' ], + 'Unapplied Credits' => [ $fsurl.'search/report_cust_credit.html?unapplied=1', 'Unapplied credit report (by type and/or date range)' ], +; + +tie my %report_refunds, 'Tie::IxHash', + 'Refund Report' => [ $fsurl.'search/report_cust_refund.html', 'Refund report (by type and/or date range)' ], + 'Unapplied Refunds' => [ $fsurl.'search/report_cust_refund.html?unapplied=1', 'Unapplied refund report (by type and/or date range)' ], +; + +tie my %report_sales, 'Tie::IxHash', + 'Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time.html', 'Sales, credits and receipts summary graph' ], + 'Daily Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time_daily.html', 'Sales, credits and receipts (broken down by day) summary graph' ], + 'Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg.html', 'Sales report and graph (by agent, package class and/or date range)' ], + 'Rated Call Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg_detail.html', 'Sales report and graph (by agent, package class, usage class and/or date range)' ], + 'Sales With Advertising Source' => [ $fsurl.'search/report_cust_bill_pkg_referral.html' ], +; + tie my %report_financial, 'Tie::IxHash'; -if($curuser->access_right('Financial reports')) { +if( $curuser->access_right('Financial reports') ) { %report_financial = ( - 'Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time.html', 'Sales, credits and receipts summary graph' ], - 'Daily Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time_daily.html', 'Sales, credits and receipts (broken down by day) summary graph' ], - 'Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg.html', 'Sales report and graph (by agent, package class and/or date range)' ], - 'Rated Call Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg_detail.html', 'Sales report and graph (by agent, package class, usage class and/or date range)' ], - 'Sales With Advertising Source' => [ $fsurl.'search/report_cust_bill_pkg_referral.html' ], - 'Employee Commission Report' => [ $fsurl.'search/report_employee_commission.html', '' ], - 'Credit Report' => [ $fsurl.'search/report_cust_credit.html', 'Credit report (by employee and/or date range)' ], - 'Unapplied Credits' => [ $fsurl.'search/report_cust_credit.html?unapplied=1', 'Unapplied credit report (by type and/or date range)' ], - 'Refund Report' => [ $fsurl.'search/report_cust_refund.html', 'Refund report (by type and/or date range)' ], - 'Unapplied Refunds' => [ $fsurl.'search/report_cust_refund.html?unapplied=1', 'Unapplied refund report (by type and/or date range)' ], - 'Package Costs Report' => [ $fsurl.'graph/report_cust_pkg_cost.html', 'Package setup and recurring costs graph' ], - 'Employee Audit Report' => [ $fsurl.'search/report_employee_audit.html', 'Employee audit report' ], + 'Sales' => [ \%report_sales, 'Sales reports', ], + 'Credits' => [ \%report_credits, 'Credit reports', ], + 'Refunds' => [ \%report_refunds, 'Refund reports', ], ); $report_financial{'A/R Aging'} = [ $fsurl.'search/report_receivables.html', 'Accounts Receivable Aging report' ]; $report_financial{'Prepaid Income'} = [ $fsurl.'search/report_prepaid_income.html', 'Prepaid income (unearned revenue) report' ]; @@ -346,36 +363,48 @@ if($curuser->access_right('Financial reports')) { } # else $report_financial contains nothing. +tie my %report_logs, 'Tie::IxHash'; + $report_logs{'System log'} = [ $fsurl.'search/log.html', 'View system events and debugging information.' ], + if $curuser->access_right('View system logs') + || $curuser->access_right('Configuration'); + $report_logs{'Outgoing messages'} = [ $fsurl.'search/cust_msg.html', 'View outgoing message log' ] + if $curuser->access_right('View email logs') + || $curuser->access_right('Configuration'); + tie my %report_menu, 'Tie::IxHash'; -$report_menu{'Prospects'} = [ \%report_prospects, 'Prospect reports' ] +$report_menu{'Prospects'} = [ \%report_prospects, 'Prospect reports' ] if $curuser->access_right('List prospects'); -$report_menu{'Quotations'} = [ \%report_quotations, 'Quotation reports' ] +$report_menu{'Quotations'} = [ \%report_quotations, 'Quotation reports' ] if $curuser->access_right('List quotations'); -$report_menu{'Customers'} = [ \%report_customers, 'Customer reports' ] +$report_menu{'Customers'} = [ \%report_customers, 'Customer reports' ] if $curuser->access_right('List customers'); -$report_menu{'Invoices'} = [ \%report_invoices, 'Invoice reports' ] +$report_menu{'Invoices'} = [ \%report_invoices, 'Invoice reports' ] if $curuser->access_right('List invoices'); -$report_menu{'Discounts'} = [ \%report_discounts, 'Discount reports' ] +$report_menu{'Discounts'} = [ \%report_discounts, 'Discount reports' ] if $curuser->access_right('Financial reports'); -$report_menu{'Payments'} = [ \%report_payments, 'Payment reports' ] +$report_menu{'Payments'} = [ \%report_payments, 'Payment reports' ] if $curuser->access_right('Financial reports'); -$report_menu{'Packages'} = [ \%report_packages, 'Package reports' ] +$report_menu{'Packages'} = [ \%report_packages, 'Package reports' ] if $curuser->access_right('List packages'); -$report_menu{'Services'} = [ \%report_services, 'Services reports' ] +$report_menu{'Services'} = [ \%report_services, 'Services reports' ] if $curuser->access_right('List services'); -$report_menu{'Inventory'} = [ \%report_inventory, 'Inventory reports' ] +$report_menu{'Inventory'} = [ \%report_inventory, 'Inventory reports' ] if $curuser->access_right('Configuration'); #XXX List inventory? -$report_menu{'Usage'} = [ \%report_rating, 'Usage reports' ] +$report_menu{'Usage'} = [ \%report_rating, 'Usage reports' ] if $curuser->access_right('List rating data'); -$report_menu{'Tickets'} = [ \%report_ticketing, 'Ticket reports' ] +$report_menu{'Tickets'} = [ \%report_ticketing, 'Ticket reports' ] if $conf->config('ticket_system') ;#&& FS::TicketSystem->access_right(\%session, 'Something'); +$report_menu{'Employees'} = [ \%report_employees, 'Employee reports' ] + if $curuser->access_right('Financial reports'); $report_menu{'Billing events'} = [ \%report_bill_event, 'Billing events' ] if $curuser->access_right('Billing event reports'); -$report_menu{'Financial'} = [ \%report_financial, 'Financial reports' ] +$report_menu{'Financial'} = [ \%report_financial, 'Financial reports' ] if $curuser->access_right('Financial reports') or $curuser->access_right('Receivables report'); -$report_menu{'SQL Query'} = [ $fsurl.'search/report_sql.html', 'SQL Query' ] +$report_menu{'Logs'} = [ \%report_logs, 'System and email logs' ] + if (keys %report_logs); # empty if the user has no rights to it +$report_menu{'SQL Query'} = [ $fsurl.'search/report_sql.html', 'SQL Query'] if $curuser->access_right('Raw SQL'); tie my %tools_importing, 'Tie::IxHash', @@ -440,8 +469,6 @@ $tools_menu{'Time Queue'} = [ $fsurl.'search/report_timeworked.html', 'View pen if $curuser->access_right('Time queue'); $tools_menu{'Attachments'} = [ $fsurl.'browse/cust_attachment.html', 'View customer attachments' ] if !$conf->config('disable_cust_attachment') and $curuser->access_right('View attachments') and $curuser->access_right('Browse attachments'); -$tools_menu{'Outgoing messages'} = [ $fsurl.'search/cust_msg.html', 'View outgoing message log' ] #shouldn't this be in the reports menu? - if $curuser->access_right('View email logs'); $tools_menu{'Importing'} = [ \%tools_importing, 'Import tools' ] if $curuser->access_right('Import'); $tools_menu{'Exporting'} = [ \%tools_exporting, 'Export tools' ] diff --git a/httemplate/elements/searchbar-address2.html b/httemplate/elements/searchbar-address2.html index d5e2b37d7..5f3b1f233 100644 --- a/httemplate/elements/searchbar-address2.html +++ b/httemplate/elements/searchbar-address2.html @@ -6,7 +6,7 @@
    - <% $menu_position eq 'left' ? '
    ' : '' %> + <% $menu_position eq 'left' ? '
    ' : '' |n %> % } diff --git a/httemplate/elements/searchbar-cust_bill.html b/httemplate/elements/searchbar-cust_bill.html index 7d24fbe9d..169315bf0 100644 --- a/httemplate/elements/searchbar-cust_bill.html +++ b/httemplate/elements/searchbar-cust_bill.html @@ -8,7 +8,7 @@
    - <% $menu_position eq 'left' ? '

    ' : '' %> + <% $menu_position eq 'left' ? '

    ' : '' |n %> % } diff --git a/httemplate/elements/searchbar-cust_main.html b/httemplate/elements/searchbar-cust_main.html index 5d79aaa5e..9a98417c8 100644 --- a/httemplate/elements/searchbar-cust_main.html +++ b/httemplate/elements/searchbar-cust_main.html @@ -5,7 +5,7 @@ <% mt('Advanced') |h %> - <% $menu_position eq 'left' ? '
    ' : '' %> + <% $menu_position eq 'left' ? '
    ' : '' |n %> % } diff --git a/httemplate/elements/searchbar-cust_svc.html b/httemplate/elements/searchbar-cust_svc.html index 766209d16..e4c2dc614 100644 --- a/httemplate/elements/searchbar-cust_svc.html +++ b/httemplate/elements/searchbar-cust_svc.html @@ -5,7 +5,7 @@ <% mt('Advanced') |h %> - <% $menu_position eq 'left' ? '
    ' : '' %> + <% $menu_position eq 'left' ? '
    ' : '' |n %> % } diff --git a/httemplate/elements/searchbar-prospect.html b/httemplate/elements/searchbar-prospect.html index 68b90d4e3..ac363796e 100644 --- a/httemplate/elements/searchbar-prospect.html +++ b/httemplate/elements/searchbar-prospect.html @@ -5,7 +5,7 @@ Adv - <% $menu_position eq 'left' ? '
    ' : '' %> + <% $menu_position eq 'left' ? '
    ' : '' |n %> % } diff --git a/httemplate/elements/searchbar-ticket.html b/httemplate/elements/searchbar-ticket.html index 30624f7d3..ae86dbcec 100644 --- a/httemplate/elements/searchbar-ticket.html +++ b/httemplate/elements/searchbar-ticket.html @@ -5,7 +5,7 @@ <% mt('Advanced') |h %> - <% $menu_position eq 'left' ? '
    ' : '' %> + <% $menu_position eq 'left' ? '
    ' : '' |n %> % } diff --git a/httemplate/elements/select-did.html b/httemplate/elements/select-did.html index a69450c2a..6e205d8ff 100644 --- a/httemplate/elements/select-did.html +++ b/httemplate/elements/select-did.html @@ -16,8 +16,10 @@ Example: % if ( $export->option('restrict_selection') eq 'non-tollfree' % || !$export->option('restrict_selection') ) { - + +% if ( $export->get_dids_npa_select ) { + + + + + + +% } else { + - + + + +% } + - +
    <% include('/elements/select-state.html', 'prefix' => 'phonenum_', #$field.'_', @@ -29,40 +31,73 @@ Example: %>
    State     		+ <% include('/elements/select-areacode.html', + 'state_prefix' => 'phonenum_', #$field.'_', + 'svcpart' => $svcpart, + 'empty' => 'Select area code', + ) + %> +
    Area code +     		+ <% include('/elements/select-exchange.html', + 'svcpart' => $svcpart, + 'empty' => 'Select exchange', + ) + %> +
    City / Exchange +     		- <% include('/elements/select-areacode.html', - 'state_prefix' => 'phonenum_', #$field.'_', - 'svcpart' => $svcpart, - 'empty' => 'Select area code', - ) - %> -
    Area code -     		- <% include('/elements/select-exchange.html', - 'svcpart' => $svcpart, - 'empty' => 'Select exchange', + <% include('/elements/select.html', + 'field' => 'phonenum_state', + 'id' => 'phonenum_state', + 'options' => [ '', @{ $export->get_dids } ], + 'labels' => { '' => 'Select province' }, + 'onchange' => 'phonenum_state_changed(this);', ) %> -
    City / Exchange +
    Province     		+ <% include('/elements/select-region.html', + 'state_prefix' => 'phonenum_', #$field.'_', + 'svcpart' => $svcpart, + 'empty' => 'Select region', + ) + %> +
    Region +     		<% include('/elements/select-phonenum.html', 'svcpart' => $svcpart, 'empty' => 'Select phone number', 'bulknum' => $bulknum, 'multiple' => $multiple, + 'region' => ! $export->get_dids_npa_select, ) %>
    Phone number
    % } -% if ( $export->option('restrict_selection') eq 'tollfree' -% || !$export->option('restrict_selection') ) { +% if ( ( $export->option('restrict_selection') eq 'tollfree' +% || !$export->option('restrict_selection') +% ) +% and $export->get_dids_can_tollfree +% ) { Toll-free <% include('/elements/select-phonenum.html', 'svcpart' => $svcpart, diff --git a/httemplate/elements/select-mib-popup.html b/httemplate/elements/select-mib-popup.html new file mode 100644 index 000000000..bd485ef65 --- /dev/null +++ b/httemplate/elements/select-mib-popup.html @@ -0,0 +1,186 @@ +<& /elements/header-popup.html &> + + + + + + + + + + + + + + + + + + + + + + + + + +
    Module:
    Object:
    + +
    Module:
    Data type:
    + +
    +<& /elements/xmlhttp.html, + url => $p.'misc/xmlhttp-mib-browse.html', + subs => [qw( search get_module_list )], +&> + +<& /elements/footer.html &> +<%init> +my $callback = 'alert("(no callback defined)" + selected_mib.stringify)'; +$cgi->param('callback') =~ /^(\w+)$/; +if ( $1 ) { + # construct the JS function call expresssion + $callback = 'window.parent.' . $1 . '(selected_mib'; + foreach ($cgi->param('arg')) { + # pass-through arguments + /^(\w+)$/ or next; + $callback .= ",'$1'"; + } + $callback .= ')'; +} + + diff --git a/httemplate/elements/select-phonenum.html b/httemplate/elements/select-phonenum.html index d555bf4b6..18abe3dea 100644 --- a/httemplate/elements/select-phonenum.html +++ b/httemplate/elements/select-phonenum.html @@ -12,7 +12,7 @@ what.options[length] = optionName; } - function <% $opt{'prefix'} %>exchange_changed(what, callback) { + function <% $opt{'prefix'} %><% $previous %>_changed(what, callback) { what.form.<% $opt{'prefix'} %>phonenum.disabled = 'disabled'; what.form.<% $opt{'prefix'} %>phonenum.style.display = 'none'; @@ -21,7 +21,7 @@ var phonenumerror = document.getElementById('<% $opt{'prefix'} %>phonenumerror'); phonenumerror.style.display = 'none'; - exchange = what.options[what.selectedIndex].value; + var thing = "<% $previous eq 'region' ? '_REGION ' : '' %>" + what.options[what.selectedIndex].value; function <% $opt{'prefix'} %>update_phonenums(phonenums) { @@ -84,7 +84,7 @@ } // go get the new phonenums - <% $opt{'prefix'} %>get_phonenums( exchange, <% $opt{'svcpart'} %>, <% $opt{'prefix'} %>update_phonenums ); + <% $opt{'prefix'} %>get_phonenums( thing, <% $opt{'svcpart'} %>, <% $opt{'prefix'} %>update_phonenums ); } @@ -126,7 +126,7 @@ % unless ( $opt{'tollfree'} ) { - + % } > + + + +<%init> + +my %opt = @_; + +$opt{disabled} = 'disabled' unless exists $opt{disabled}; + + diff --git a/httemplate/elements/select-terms.html b/httemplate/elements/select-terms.html index d63c49219..a66aa29ae 100644 --- a/httemplate/elements/select-terms.html +++ b/httemplate/elements/select-terms.html @@ -33,7 +33,7 @@ my $empty_label = my $empty_value = $opt{'empty_value'} || ''; my @terms = ( emt('Payable upon receipt'), - ( map "Net $_", 0, 3, 9, 10, 15, 20, 30, 45, 60, 90 ), + ( map "Net $_", 0, 3, 9, 10, 15, 18, 20, 30, 45, 60, 90 ), ); my @pre_options = $opt{pre_options} ? @{ $opt{pre_options} } : (); diff --git a/httemplate/elements/standardize_locations.js b/httemplate/elements/standardize_locations.js index d9c1df7e6..15c5761a0 100644 --- a/httemplate/elements/standardize_locations.js +++ b/httemplate/elements/standardize_locations.js @@ -1,3 +1,9 @@ +function status_message(text, caption) { + text = '

    ' + text + '

    '; + caption = caption || 'Please wait...'; + overlib(text, WIDTH, 444, HEIGHT, 168, CAPTION, caption, STICKY, AUTOSTATUSCAP, CLOSECLICK, MIDX, 0, MIDY, 0); +} + function form_address_info() { var cf = document.<% $formname %>; @@ -87,8 +93,7 @@ function standardize_locations() { % if ( $conf->config('address_standardize_method') ) { if ( changed ) { - var startup_msg = '

    Verifying address...

    '; - overlib(startup_msg, WIDTH, 444, HEIGHT, 168, CAPTION, 'Please wait...', STICKY, AUTOSTATUSCAP, CLOSECLICK, MIDX, 0, MIDY, 0); + status_message('Verifying address...'); address_standardize(JSON.stringify(address_info), confirm_standardize); } else { @@ -116,8 +121,14 @@ function confirm_standardize(arg) { replace_address(); // with the contents of returned['new'] - } - else { + } else if ( returned['all_same'] ) { + + // then all entered address fields are correct + // but we still need to set the lat/long fields and addr_clean + status_message('Verified'); + replace_address(); + + } else { var querystring = encodeURIComponent( JSON.stringify(returned) ); // confirmation popup: knows to call replace_address(), diff --git a/httemplate/elements/xmlhttp.html b/httemplate/elements/xmlhttp.html index ac6f9916e..a9e65c790 100644 --- a/httemplate/elements/xmlhttp.html +++ b/httemplate/elements/xmlhttp.html @@ -14,14 +14,15 @@ Example: ); -<% include( '/elements/rs_init_object.html' ) %> +<& /elements/rs_init_object.html &> +<& /elements/init_overlib.html &> + +
    + + + + +<& /elements/footer.html &> +<%init> + +#Financial reports? +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('List invoices'); + +my $conf = new FS::Conf; + +#other available params (cust_bill_pkg.cgi): +# +#distribute = 1 +# +#(when nottax) +# use_override something about part_pkg +# classnum package class +# taxclass / taxclassNULL +# exempt_cust +# exempt_pkg +# region (country:state:county:city:district) +# taxable +# out (of taxable region) +# usage +#(when istax) +# locationtaxid (& district/city/ciounty/state) +# out (of taxable region) +# taxclassNULL +# report_group (itemdesc) +# itemdesc +# +#taxname/taxnameNULL cust_main_county +#taxnum cust_main_county +#credit (hmm need to look more at what this does) + + + + diff --git a/httemplate/search/report_cust_credit_bill_pkg.html b/httemplate/search/report_cust_credit_bill_pkg.html new file mode 100644 index 000000000..2b9e1e69d --- /dev/null +++ b/httemplate/search/report_cust_credit_bill_pkg.html @@ -0,0 +1,104 @@ +<& /elements/header.html, mt('Credit application report') &> + +
    + + + emt('Employee: '), + 'access_user' => \%access_user, +&> + +<& /elements/tr-select-agent.html, + curr_value => scalar( $cgi->param('agentnum') ), + #label => emt('Line items for agent: '), + disable_empty => 0, +&> + + + + + + +<& /elements/tr-input-beginning_ending.html, + 'prefix' => 'credit', +&> + +<& /elements/tr-input-lessthan_greaterthan.html, + label => emt('Amount'), + field => 'amount', +&> + + + + + +
    + +
    + + +
    + +<& /elements/footer.html &> +<%init> + +#Financial reports? +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Financial reports'); + +#false laziness w/report_cust_credit.html +my $sth = dbh->prepare("SELECT DISTINCT usernum FROM cust_credit") + or die dbh->errstr; +$sth->execute or die $sth->errstr; +my @usernum = map $_->[0], @{$sth->fetchall_arrayref}; +my %access_user = + map { $_ => qsearchs('access_user',{'usernum'=>$_})->username } + @usernum; + +my $conf = new FS::Conf; + + + diff --git a/httemplate/search/report_tax-xls.cgi b/httemplate/search/report_tax-xls.cgi index f19f85aaa..bb843a73f 100755 --- a/httemplate/search/report_tax-xls.cgi +++ b/httemplate/search/report_tax-xls.cgi @@ -1,4 +1,3 @@ -<% $data %> <%init> my $htmldoc = include('report_tax.cgi'); @@ -155,4 +154,6 @@ for my $x (0..scalar(@widths)-1) { $workbook->close; +http_header('Content-Length' => length($data)); +$m->print($data); diff --git a/httemplate/view/cust_main/payment_history.html b/httemplate/view/cust_main/payment_history.html index 166addbf4..6630d12a5 100644 --- a/httemplate/view/cust_main/payment_history.html +++ b/httemplate/view/cust_main/payment_history.html @@ -70,6 +70,16 @@ 'actionlabel' => emt('Enter credit'), 'width' => 616, #make room for reasons #540 default &> + | + <& /elements/popup_link-cust_main.html, + 'label' => emt('Credit line items'), + #'action' => "${p}search/cust_bill_pkg.cgi?nottax=1;type=select", + 'action' => "${p}edit/credit-cust_bill_pkg.html", + 'cust_main' => $cust_main, + 'actionlabel' => emt('Credit line items'), + 'width' => 884, #763, + 'height' => 575, + &>
    % } diff --git a/httemplate/view/part_event-targets.html b/httemplate/view/part_event-targets.html index 2029fd4bc..e8b1266ef 100644 --- a/httemplate/view/part_event-targets.html +++ b/httemplate/view/part_event-targets.html @@ -65,9 +65,6 @@ When event is run on <& /elements/input-date-field.html, { %} <& /elements/footer.html &> -<%once> -use List::MoreUtils qw(uniq); - <%init> my $curuser = $FS::CurrentUser::CurrentUser; diff --git a/rt/Makefile.in b/rt/Makefile.in index b415a06db..fbe3fae9f 100644 --- a/rt/Makefile.in +++ b/rt/Makefile.in @@ -157,6 +157,7 @@ SYSTEM_BINARIES = rt-attributes-viewer \ rt-shredder \ rt-test-dependencies \ rt-validator \ + rt-validate-aliases \ standalone_httpd diff --git a/rt/configure b/rt/configure index 76ef85b92..caf3967a2 100755 --- a/rt/configure +++ b/rt/configure @@ -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 rt-4.0.7. +# Generated by GNU Autoconf 2.68 for RT rt-4.0.8. # # Report bugs to . # @@ -560,8 +560,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='RT' PACKAGE_TARNAME='rt' -PACKAGE_VERSION='rt-4.0.7' -PACKAGE_STRING='RT rt-4.0.7' +PACKAGE_VERSION='rt-4.0.8' +PACKAGE_STRING='RT rt-4.0.8' PACKAGE_BUGREPORT='rt-bugs@bestpractical.com' PACKAGE_URL='' @@ -1311,7 +1311,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 rt-4.0.7 to adapt to many kinds of systems. +\`configure' configures RT rt-4.0.8 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1372,7 +1372,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of RT rt-4.0.7:";; + short | recursive ) echo "Configuration of RT rt-4.0.8:";; esac cat <<\_ACEOF @@ -1496,7 +1496,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -RT configure rt-4.0.7 +RT configure rt-4.0.8 generated by GNU Autoconf 2.68 Copyright (C) 2010 Free Software Foundation, Inc. @@ -1597,7 +1597,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 rt-4.0.7, which was +It was created by RT $as_me rt-4.0.8, which was generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -1954,7 +1954,7 @@ rt_version_major=4 rt_version_minor=0 -rt_version_patch=7 +rt_version_patch=8 test "x$rt_version_major" = 'x' && rt_version_major=0 test "x$rt_version_minor" = 'x' && rt_version_minor=0 @@ -3923,7 +3923,7 @@ RT_LOG_PATH_R=${exp_logfiledir} fi -ac_config_files="$ac_config_files etc/upgrade/3.8-branded-queues-extension etc/upgrade/3.8-ical-extension etc/upgrade/split-out-cf-categories etc/upgrade/generate-rtaddressregexp etc/upgrade/upgrade-articles etc/upgrade/vulnerable-passwords sbin/rt-attributes-viewer sbin/rt-preferences-viewer sbin/rt-session-viewer sbin/rt-dump-metadata sbin/rt-setup-database sbin/rt-test-dependencies sbin/rt-email-digest sbin/rt-email-dashboards sbin/rt-clean-sessions sbin/rt-shredder sbin/rt-validator sbin/rt-email-group-admin sbin/rt-server sbin/rt-server.fcgi sbin/standalone_httpd sbin/rt-setup-fulltext-index sbin/rt-fulltext-indexer bin/rt-crontool bin/rt-mailgate bin/rt" +ac_config_files="$ac_config_files etc/upgrade/3.8-branded-queues-extension etc/upgrade/3.8-ical-extension etc/upgrade/split-out-cf-categories etc/upgrade/generate-rtaddressregexp etc/upgrade/upgrade-articles etc/upgrade/vulnerable-passwords sbin/rt-attributes-viewer sbin/rt-preferences-viewer sbin/rt-session-viewer sbin/rt-dump-metadata sbin/rt-setup-database sbin/rt-test-dependencies sbin/rt-email-digest sbin/rt-email-dashboards sbin/rt-clean-sessions sbin/rt-shredder sbin/rt-validator sbin/rt-validate-aliases sbin/rt-email-group-admin sbin/rt-server sbin/rt-server.fcgi sbin/standalone_httpd sbin/rt-setup-fulltext-index sbin/rt-fulltext-indexer bin/rt-crontool bin/rt-mailgate bin/rt" ac_config_files="$ac_config_files Makefile etc/RT_Config.pm lib/RT/Generated.pm t/data/configs/apache2.2+mod_perl.conf t/data/configs/apache2.2+fastcgi.conf" @@ -4482,7 +4482,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 rt-4.0.7, which was +This file was extended by RT $as_me rt-4.0.8, which was generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -4535,7 +4535,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 rt-4.0.7 +RT config.status rt-4.0.8 configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" @@ -4663,6 +4663,7 @@ do "sbin/rt-clean-sessions") CONFIG_FILES="$CONFIG_FILES sbin/rt-clean-sessions" ;; "sbin/rt-shredder") CONFIG_FILES="$CONFIG_FILES sbin/rt-shredder" ;; "sbin/rt-validator") CONFIG_FILES="$CONFIG_FILES sbin/rt-validator" ;; + "sbin/rt-validate-aliases") CONFIG_FILES="$CONFIG_FILES sbin/rt-validate-aliases" ;; "sbin/rt-email-group-admin") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-group-admin" ;; "sbin/rt-server") CONFIG_FILES="$CONFIG_FILES sbin/rt-server" ;; "sbin/rt-server.fcgi") CONFIG_FILES="$CONFIG_FILES sbin/rt-server.fcgi" ;; @@ -5131,6 +5132,8 @@ which seems to be undefined. Please make sure it is defined" >&2;} ;; "sbin/rt-validator":F) chmod ug+x $ac_file ;; + "sbin/rt-validate-aliases":F) chmod ug+x $ac_file + ;; "sbin/rt-email-group-admin":F) chmod ug+x $ac_file ;; "sbin/rt-server":F) chmod ug+x $ac_file diff --git a/rt/configure.ac b/rt/configure.ac index be02a684e..a168e285c 100644 --- a/rt/configure.ac +++ b/rt/configure.ac @@ -425,6 +425,7 @@ AC_CONFIG_FILES([ sbin/rt-clean-sessions sbin/rt-shredder sbin/rt-validator + sbin/rt-validate-aliases sbin/rt-email-group-admin sbin/rt-server sbin/rt-server.fcgi diff --git a/rt/devel/tools/apache.conf b/rt/devel/tools/apache.conf deleted file mode 100644 index 2ae67c651..000000000 --- a/rt/devel/tools/apache.conf +++ /dev/null @@ -1,173 +0,0 @@ -# Single-process Apache testing with mod_perl, mod_fcgi, or mod_fastcgi -# -# Start this via: -# apache2 -f `pwd`/devel/tools/apache.conf -DPERL -k start -# -# The full path to the configuration file is needed, or Apache assumes -# it is under the ServerRoot. Since the deployment strategies differ -# between RT 3 and 4, you must either supply -DRT3 if you are attempting -# to deploy an rt3 instance. You must also supply one of -DPERL, -# -DFASTCGI, or -DFCGID. -# -# The /opt/rt4/etc/apache_local.conf file should contain: -# User chmrr -# Group chmrr -# Listen 8080 -# ...or the equivilent. -# -# Apache access and error logs will be written to /opt/rt4/var/log/. -# - -Include /opt/rt4/etc/apache_local.conf - - -Include /opt/rt3/etc/apache_local.conf - - - - StartServers 1 - MinSpareServers 1 - MaxSpareServers 1 - MaxClients 1 - MaxRequestsPerChild 0 - - - - StartServers 1 - MinSpareThreads 1 - MaxSpareThreads 1 - ThreadLimit 1 - ThreadsPerChild 1 - MaxClients 1 - MaxRequestsPerChild 0 - - -ServerRoot /etc/apache2 -PidFile /opt/rt4/var/apache2.pid -LockFile /opt/rt4/var/apache2.lock -ServerAdmin root@localhost - -LoadModule authz_host_module /usr/lib/apache2/modules/mod_authz_host.so -LoadModule env_module /usr/lib/apache2/modules/mod_env.so -LoadModule alias_module /usr/lib/apache2/modules/mod_alias.so -LoadModule mime_module /usr/lib/apache2/modules/mod_mime.so - - LoadModule perl_module /usr/lib/apache2/modules/mod_perl.so - - - LoadModule fastcgi_module /usr/lib/apache2/modules/mod_fastcgi.so - - - LoadModule fcgid_module /usr/lib/apache2/modules/mod_fcgid.so - - -ErrorLog "/opt/rt4/var/log/apache-error.log" -TransferLog "/opt/rt4/var/log/apache-access.log" -LogLevel debug - - - Options FollowSymLinks - AllowOverride None - Order deny,allow - Deny from all - - -AddDefaultCharset UTF-8 - -DocumentRoot /var/www - - Order allow,deny - Allow from all - - -Alias /NoAuth/images/ /opt/rt4/share/html/NoAuth/images/ - - Order allow,deny - Allow from all - - - -########## 4.0 mod_perl - - PerlSetEnv RT_SITE_CONFIG /opt/rt4/etc/RT_SiteConfig.pm - - Order allow,deny - Allow from all - SetHandler modperl - PerlResponseHandler Plack::Handler::Apache2 - PerlSetVar psgi_app /opt/rt4/sbin/rt-server - - - use Plack::Handler::Apache2; - Plack::Handler::Apache2->preload("/opt/rt4/sbin/rt-server"); - - - -########## 4.0 mod_fastcgi - - FastCgiIpcDir /opt/rt4/var - FastCgiServer /opt/rt4/sbin/rt-server.fcgi -processes 1 -idle-timeout 300 - ScriptAlias / /opt/rt4/sbin/rt-server.fcgi/ - - Order allow,deny - Allow from all - Options +ExecCGI - AddHandler fastcgi-script fcgi - - - -########## 4.0 mod_fcgid - - FcgidProcessTableFile /opt/rt4/var/fcgid_shm - FcgidIPCDir /opt/rt4/var - ScriptAlias / /opt/rt4/sbin/rt-server.fcgi/ - - Order allow,deny - Allow from all - Options +ExecCGI - AddHandler fcgid-script fcgi - - - - - - -########## 3.8 mod_perl - - PerlSetEnv RT_SITE_CONFIG /opt/rt3/etc/RT_SiteConfig.pm - PerlRequire "/opt/rt3/bin/webmux.pl" - - SetHandler default - - - SetHandler perl-script - PerlResponseHandler RT::Mason - - - -########## 3.8 mod_fastcgi - - FastCgiIpcDir /opt/rt3/var - FastCgiServer /opt/rt3/bin/mason_handler.fcgi -processes 1 -idle-timeout 300 - ScriptAlias / /opt/rt3/bin/mason_handler.fcgi/ - - Order allow,deny - Allow from all - Options +ExecCGI - AddHandler fastcgi-script fcgi - - - -########## 3.8 mod_fcgid - - FcgidProcessTableFile /opt/rt3/var/fcgid_shm - FcgidIPCDir /opt/rt3/var - ScriptAlias / /opt/rt3/bin/mason_handler.fcgi/ - - Order allow,deny - Allow from all - Options +ExecCGI - AddHandler fcgid-script fcgi - - - diff --git a/rt/docs/UPGRADING-2.0 b/rt/docs/UPGRADING-2.0 index a935552b5..792276f07 100644 --- a/rt/docs/UPGRADING-2.0 +++ b/rt/docs/UPGRADING-2.0 @@ -1,7 +1,7 @@ -UPGRADING FROM 2.x: +=head1 UPGRADING FROM 2.x -The core RT distribution does not contain the tool to upgrade RT from -version 2.0; the tool, can be downloaded from CPAN at +The core RT distribution does not contain the tool to upgrade RT from version +2.0; the tool, can be downloaded from CPAN at http://search.cpan.org/dist/RT-Extension-RT2toRT3/ Further instructions may be found in that distribution's README file. diff --git a/rt/docs/UPGRADING-3.0 b/rt/docs/UPGRADING-3.0 index 625ca4baf..1bc1b55d3 100644 --- a/rt/docs/UPGRADING-3.0 +++ b/rt/docs/UPGRADING-3.0 @@ -1,18 +1,20 @@ -UPGRADING FROM 3.0.x - Changes: +=head1 UPGRADING FROM 3.0.0 AND EARLIER -= Installation = +=head2 Installation We recommend you move your existing /opt/rt3 tree completely out of the way before installing the new version of RT, to make sure that you don't inadvertently leave old files hanging around. -= Rights changes = + +=head2 Rights changes Now, if you want RT to automatically create new users upon ticket submission, you MUST grant 'Everyone' the right to create tickets. Granting this right only to "Unprivileged Users" is now insufficient. -= Web server configuration + +=head2 Web server configuration The configuration for RT's web interface has changed. Please refer to docs/web_deployment.pod for instructions. diff --git a/rt/docs/UPGRADING-3.2 b/rt/docs/UPGRADING-3.2 index c0b8cebae..4641209e4 100644 --- a/rt/docs/UPGRADING-3.2 +++ b/rt/docs/UPGRADING-3.2 @@ -1,11 +1,10 @@ -UPGRADING FROM 3.2 and earlier - Changes: +=head1 UPGRADING FROM 3.2.0 AND EARLIER -= Rights changes = +There have been a number of rights changes. Now, if you want any user to be +able to access the Admin tools (a.k.a. the Configuration tab), you must grant +that user the "ShowConfigTab" right. Making the user a privileged user is no +longer sufficient. -Now, if you want any user to be able to access the Admin tools (a.k.a. -the Configuration tab), you must grant that user the "ShowConfigTab" -right. Making the user a privileged user is no longer sufficient. - -"SuperUser" users are no longer automatically added to the list of users -who can own tickets in a queue. You now need to explicitly give them the +"SuperUser" users are no longer automatically added to the list of users who +can own tickets in a queue. You now need to explicitly give them the "OwnTicket" right. diff --git a/rt/docs/UPGRADING-3.4 b/rt/docs/UPGRADING-3.4 index 4dca0451f..89454bdef 100644 --- a/rt/docs/UPGRADING-3.4 +++ b/rt/docs/UPGRADING-3.4 @@ -1,12 +1,11 @@ -UPGRADING FROM 3.3.14 and earlier - Changes: +=head1 UPGRADING FROM 3.3.14 AND EARLIER The "ModifyObjectCustomFieldValues" right name was too long. It has been changed to "ModifyCustomField" -UPGRADING FROM 3.3.11 and earlier - Changes: +=head1 UPGRADING FROM 3.3.11 AND EARLIER -Custom Fields now have an additional right, "ModifyCustomField". This -right governs whether a user can modify an object's custom field values -for a particular custom field. This includes adding, deleting and -changing values. +Custom Fields now have an additional right, "ModifyCustomField". This right +governs whether a user can modify an object's custom field values for a +particular custom field. This includes adding, deleting and changing values. diff --git a/rt/docs/UPGRADING-3.6 b/rt/docs/UPGRADING-3.6 index 3c27709cb..da656c9e5 100644 --- a/rt/docs/UPGRADING-3.6 +++ b/rt/docs/UPGRADING-3.6 @@ -1,29 +1,27 @@ -UPGRADING FROM 3.6.X and earlier - Changes: +=head1 UPGRADING FROM 3.6.0 AND EARLIER -As there are a large number of code changes, it is highly recommended -that you install RT into a fresh directory, and then reinstall your -customizations. +As there are a large number of code changes, it is highly recommended that you +install RT into a fresh directory, and then reinstall your customizations. -The database schema has changed significantly for mysql 4.1 and above; -please read UPGRADING.mysql for more details. +The database schema has changed significantly for mysql 4.1 and above; please +read UPGRADING.mysql for more details. -The configuration format has been made stricter. All options MUST be set -using the Set function; the historical "@XXX = (...) unless @XXX;" is no -longer allowed. +The configuration format has been made stricter. All options MUST be set using +the Set function; the historical "@XXX = (...) unless @XXX;" is no longer +allowed. The RTx::Shredder extension has been integrated into core, and several features have been added, so you MUST uninstall it before upgrading. -A new interface for making links in text clickable, and doing other -arbitrary text replacements, has been integrated into RT. You can read -more in `perldoc docs/extending/clickable_links.pod`. +A new interface for making links in text clickable, and doing other arbitrary +text replacements, has been integrated into RT. You can read more in `perldoc +docs/extending/clickable_links.pod`. -A new feature has been added that allows users to forward -messages. There is a new option in the config ($ForwardFromUser), new -rights, and a new template. +A new feature has been added that allows users to forward messages. There is a +new option in the config ($ForwardFromUser), new rights, and a new template. -New global templates have been added with "Error: " prefixed to the name -to make it possible to configure error messages sent to users. +New global templates have been added with "Error: " prefixed to the name to +make it possible to configure error messages sent to users. You can read about the new GnuPG integration in `perldoc lib/RT/Crypt/GnuPG.pm`. @@ -31,19 +29,19 @@ lib/RT/Crypt/GnuPG.pm`. New scrip conditions 'On Close' and 'On Reopen' have been added. -UPGRADING FROM 3.5.7 and earlier - Changes: +=head1 UPGRADING FROM 3.5.7 AND EARLIER Scrips are now prepared and committed in order alphanumerically by -description. This means that you can prepend a number (00, 07, 15, 24) -to the beginning of each scrip's description, and they will run in that -order. Depending on your database, the old ordering may have been by -scrip id number -- if that is the case, simply prepend the scrip id -number to the beginning of its description. +description. This means that you can prepend a number (00, 07, 15, 24) to the +beginning of each scrip's description, and they will run in that order. +Depending on your database, the old ordering may have been by scrip id number +-- if that is the case, simply prepend the scrip id number to the beginning of +its description. -UPGRADING FROM 3.5.1 and earlier - Changes: +=head1 UPGRADING FROM 3.5.1 AND EARLIER The default for $RedistributeAutoGeneratedMessages has changed to 'privileged', to make out-of-the-box installations more resistant to -mail loops. If you rely on the old default of redistributing to all -watchers, you'll need to set it explicitly now. +mail loops. If you rely on the old default of redistributing to all watchers, +you'll need to set it explicitly now. diff --git a/rt/docs/UPGRADING-3.8 b/rt/docs/UPGRADING-3.8 index cb53030e4..cfe01dfbf 100644 --- a/rt/docs/UPGRADING-3.8 +++ b/rt/docs/UPGRADING-3.8 @@ -1,110 +1,111 @@ -UPGRADING FROM 3.8.8 and earlier - Changes: +=head1 UPGRADING FROM 3.8.8 AND EARLIER -Previous versions of RT used a password hashing scheme which was too -easy to reverse, which could allow attackers with read access to the RT -database to possibly compromise users' passwords. Even if RT does no -password authentication itself, it may still store these weak password -hashes -- using ExternalAuth does not guarantee that you are not -vulnerable! To upgrade stored passwords to a stronger hash, run: +Previous versions of RT used a password hashing scheme which was too easy to +reverse, which could allow attackers with read access to the RT database to +possibly compromise users' passwords. Even if RT does no password +authentication itself, it may still store these weak password hashes -- using +ExternalAuth does not guarantee that you are not vulnerable! To upgrade +stored passwords to a stronger hash, run: perl etc/upgrade/vulnerable-passwords -We have also proved that it's possible to delete a notable set of -records from Transactions table without losing functionality. To delete -these records, run the following script: +We have also proved that it's possible to delete a notable set of records from +Transactions table without losing functionality. To delete these records, run +the following script: perl -I /opt/rt4/local/lib -I /opt/rt4/lib etc/upgrade/shrink_transactions_table.pl -If you chose not to run the shrink_cgm_table.pl script when you upgraded -to 3.8, you should read more about it below and run it at this point. +If you chose not to run the shrink_cgm_table.pl script when you upgraded to +3.8, you should read more about it below and run it at this point. -The default for $MessageBoxWrap is now SOFT and $MessageBoxWidth is now -unset by default. This means the message box will expand to fill all -the available width. $MessageBoxWrap is also overridable by the user -now. These changes accommodate the new default two column layout for -ticket create and update pages. You may turn this layout off by setting -$UseSideBySideLayout to 0. To retain the original behavior, set -$MessageBoxWrap to HARD and $MessageBoxWidth to 72. +The default for $MessageBoxWrap is now SOFT and $MessageBoxWidth is now unset +by default. This means the message box will expand to fill all the available +width. $MessageBoxWrap is also overridable by the user now. These changes +accommodate the new default two column layout for ticket create and update +pages. You may turn this layout off by setting $UseSideBySideLayout to 0. To +retain the original behavior, set $MessageBoxWrap to HARD and $MessageBoxWidth +to 72. -UPGRADING FROM 3.8.7 and earlier - Changes: +=head1 UPGRADING FROM 3.8.7 AND EARLIER -RT's ChartFont option has been changed from a string to a hash which -lets you specify per-language fonts. RT now comes with a better default -font for charts, too. You should either update your 'ChartFont' option -to match the new format, or consider trying the new default. +RT's ChartFont option has been changed from a string to a hash which lets you +specify per-language fonts. RT now comes with a better default font for +charts, too. You should either update your 'ChartFont' option to match the +new format, or consider trying the new default. -RT now gives you more precise control over the order in which custom -fields are displayed. This change requires some small changes to your -currently saved custom field orders. RT will automatically clean up -your existing custom fields when you run the standard database upgrade -steps. After that cleanup, you should make sure that custom fields are -ordered in a way that you and your users find pleasing. +RT now gives you more precise control over the order in which custom fields +are displayed. This change requires some small changes to your currently +saved custom field orders. RT will automatically clean up your existing +custom fields when you run the standard database upgrade steps. After that +cleanup, you should make sure that custom fields are ordered in a way that you +and your users find pleasing. -UPGRADING FROM 3.8.6 and earlier - Changes: +=head1 UPGRADING FROM 3.8.6 AND EARLIER -For MySQL and Oracle users: -If you upgraded from a version of RT earlier than 3.7.81, you should -already have a CachedGroupMembers3 index on your CachedGroupMembers -table. If you did a clean install of RT somewhere in the 3.8 release -series, you most likely don't have this index. You can add it manually -with: +For MySQL and Oracle users: if you upgraded from a version of RT earlier than +3.7.81, you should already have a CachedGroupMembers3 index on your +CachedGroupMembers table. If you did a clean install of RT somewhere in the +3.8 release series, you most likely don't have this index. You can add it +manually with: CREATE INDEX CachedGroupMembers3 on CachedGroupMembers (MemberId, ImmediateParentId); -UPGRADING FROM 3.8.5 and earlier - Changes: +=head1 UPGRADING FROM 3.8.5 AND EARLIER You can now forward an entire Ticket history (in addition to specific -transactions) but this requires a new Template called "Forward Ticket". -This template will be added as part of the standard database upgrade -step. +transactions) but this requires a new Template called "Forward Ticket". This +template will be added as part of the standard database upgrade step. -Custom fields with categories can optionally be split out into -hierarchical custom fields. If you wish to convert your old -category-based custom fields, run: +Custom fields with categories can optionally be split out into hierarchical +custom fields. If you wish to convert your old category-based custom fields, +run: perl etc/upgrade/split-out-cf-categories -It will prompt you for each custom field with categories that it finds, -and the name of the custom field to create to store the categories. +It will prompt you for each custom field with categories that it finds, and +the name of the custom field to create to store the categories. -If you were using the LocalizedDateTime RT::Date formatter from custom -code, and passing a DateFormat or TimeFormat argument, you need to -switch from the strftime methods to the cldr methods; that is, +If you were using the LocalizedDateTime RT::Date formatter from custom code, +and passing a DateFormat or TimeFormat argument, you need to switch from the +strftime methods to the cldr methods; that is, 'full_date_format' becomes 'date_format_full'. You may also have done this from your RT_SiteConfig.pm, using: + Set($DateTimeFormat, { Format => 'LocalizedDateTime', DateFormat => 'medium_date_format', ); + Which would need to be changed to: + Set($DateTimeFormat, { Format => 'LocalizedDateTime', DateFormat => 'date_format_medium', ); -UPGRADING FROM 3.8.3 and earlier - Changes: +=head1 UPGRADING FROM 3.8.3 AND EARLIER Arguments to the NotifyGroup Scrip Action will be updated as part of the standard database upgrade process. -UPGRADING FROM 3.8.2 and earlier - Changes: +=head1 UPGRADING FROM 3.8.2 AND EARLIER A new scrip condition, 'On Reject', has been added. -UPGRADING FROM 3.8.1 and earlier - Changes: +=head1 UPGRADING FROM 3.8.1 AND EARLIER -When using Oracle, $DatabaseName is now used as SID, so RT can connect -without environment variables or tnsnames.ora file. Because of this -change, your RT instance may loose its ability to connect to your DB; to -resolve this, you will need to update RT's configuration and restart -your web server. Example configuration: +When using Oracle, $DatabaseName is now used as SID, so RT can connect without +environment variables or tnsnames.ora file. Because of this change, your RT +instance may loose its ability to connect to your DB; to resolve this, you +will need to update RT's configuration and restart your web server. Example +configuration: Set($DatabaseType, 'Oracle'); Set($DatabaseHost, '192.168.0.1'); @@ -121,72 +122,70 @@ If you want a user to be able to access the Approvals tools (a.k.a. the Approvals tab), you must grant that user the "ShowApprovalsTab" right. -UPGRADING FROM 3.8.0 and earlier - Changes: +=head1 UPGRADING FROM 3.8.0 AND EARLIER -The TicketSQL syntax for bookmarked tickets has been changed. -Specifically, the new phrasing is "id = '__Bookmarked__'", rather than -the old "__Bookmarks__". The old form will remain, for backwards -compatibility. The standard database upgrade process will only -automatically change the global 'Bookmarked Tickets' search +The TicketSQL syntax for bookmarked tickets has been changed. Specifically, +the new phrasing is "id = '__Bookmarked__'", rather than the old +"__Bookmarks__". The old form will remain, for backwards compatibility. The +standard database upgrade process will only automatically change the +global 'Bookmarked Tickets' search -UPGRADING FROM 3.7.85 and earlier - Changes: +=head1 UPGRADING FROM 3.7.85 AND EARLIER -We have proved that it is possible to delete a large set of records from -the CachedGroupMembers table without losing functionality; in fact, -failing to do so may result in occasional problems where RT miscounts -users, particularly in the chart functionality. To delete these records -run the following script: +We have proved that it is possible to delete a large set of records from the +CachedGroupMembers table without losing functionality; in fact, failing to do +so may result in occasional problems where RT miscounts users, particularly in +the chart functionality. To delete these records run the following script: perl -I /opt/rt4/local/lib -I /opt/rt4/lib etc/upgrade/shrink_cgm_table.pl -After you run this, you will have significantly reduced the number of -records in your CachedGroupMembers table, and may need to tell your -database to refresh indexes/statistics. Please consult your DBA for -specific instructions for your database. +After you run this, you will have significantly reduced the number of records +in your CachedGroupMembers table, and may need to tell your database to +refresh indexes/statistics. Please consult your DBA for specific instructions +for your database. -UPGRADING FROM 3.7.81 and earlier - Changes: +=head1 UPGRADING FROM 3.7.81 AND EARLIER -RT::Extension::BrandedQueues has been integrated into core, and the -handling of subject tags has changed as a consequence. You will need to -modify any of your email templates which use the $rtname variable, in -order to make them respect the per-queue subject tags. To edit your -templates, log into RT as your administrative user, then click: +RT::Extension::BrandedQueues has been integrated into core, and the handling +of subject tags has changed as a consequence. You will need to modify any of +your email templates which use the $rtname variable, in order to make them +respect the per-queue subject tags. To edit your templates, log into RT as +your administrative user, then click: Configuration -> Global -> Templates -> Select -> -The only template which ships with RT which needs updating is the -"Autoreply" template, which includes this line: +The only template which ships with RT which needs updating is the "Autoreply" +template, which includes this line: - "There is no need to reply to this message right now. Your ticket - has been assigned an ID of [{$rtname} #{$Ticket->id()}]." + "There is no need to reply to this message right now. Your ticket has + been assigned an ID of [{$rtname} #{$Ticket->id()}]." Change this line to read: - "There is no need to reply to this message right now. Your ticket - has been assigned an ID of { $Ticket->SubjectTag }." + "There is no need to reply to this message right now. Your ticket has + been assigned an ID of { $Ticket->SubjectTag }." -If you were previously using RT::Extension::BrandedQueues, you MUST -uninstall it before upgrading. In addition, you must run the +If you were previously using RT::Extension::BrandedQueues, you MUST uninstall +it before upgrading. In addition, you must run the 'etc/upgrade/3.8-branded-queues-extension' perl script. This will convert the extension's configuration into the new format. Finally, in templates where you were using the Tag method ($Ticket->QueueObj->Tag), you will need to replace it with $Ticket->SubjectTag -RT::Action::LinearEscalate extension has been integrated into core, -so you MUST uninstall it before upgrading. +RT::Action::LinearEscalate extension has been integrated into core, so you +MUST uninstall it before upgrading. -RT::Extension::iCal has been integrated into core, so you MUST uninstall -it before upgrading. In addition, you must run etc/upgrade/3.8-ical-extension +RT::Extension::iCal has been integrated into core, so you MUST uninstall it +before upgrading. In addition, you must run etc/upgrade/3.8-ical-extension script to convert old data. -UPGRADING FROM 3.7.80 and earlier - Changes: +=head1 UPGRADING FROM 3.7.80 AND EARLIER -Added indexes to CachedGroupMembers for MySQL and Oracle. -If you have previously installed RTx-Shredder, you may already -have these indexes. You can see the indexes by looking at -etc/upgrade/3.7.81/schema.* +Added indexes to CachedGroupMembers for MySQL and Oracle. If you have +previously installed RTx-Shredder, you may already have these indexes. You +can see the indexes by looking at etc/upgrade/3.7.81/schema.* These indexes may take a very long time to create. diff --git a/rt/docs/UPGRADING-4.0 b/rt/docs/UPGRADING-4.0 index 4b64d2e72..ad8d87b5f 100644 --- a/rt/docs/UPGRADING-4.0 +++ b/rt/docs/UPGRADING-4.0 @@ -1,87 +1,99 @@ -Common Issues +=head1 UPGRADING FROM BEFORE 4.0.0 -RT now defaults to a database name of rt4 and an installation root of /opt/rt4. +=head2 Common issues -If you are upgrading, you will likely want to specify that your database -is still named rt3 (or import a backup of your database as rt4 so that -you can feel more confident making the upgrade). +RT now defaults to a database name of rt4 and an installation root of +/opt/rt4. -You really shouldn't install RT4 into your RT3 source tree (/opt/rt3) -and instead should be using make install to set up a clean environment. -This will allow you to evaluate your local modifications and configuration -changes as you migrate to 4.0. +If you are upgrading, you will likely want to specify that your database is +still named rt3 (or import a backup of your database as rt4 so that you can +feel more confident making the upgrade). + +You really shouldn't install RT4 into your RT3 source tree (/opt/rt3) and +instead should be using make install to set up a clean environment. This will +allow you to evaluate your local modifications and configuration changes as +you migrate to 4.0. If you choose to force RT to install into /opt/rt3, or another existing RT 3.x install location, you will encounter issues because we removed the _Overlay -files (such as Ticket_Overlay.pm) and relocated other files. You will -need to manually remove these files after the upgrade or RT will fail. -After making a complete backup of your /opt/rt3 install, you might use a -command like the following to remove the _Overlay files: +files (such as Ticket_Overlay.pm) and relocated other files. You will need to +manually remove these files after the upgrade or RT will fail. After making a +complete backup of your /opt/rt3 install, you might use a command like the +following to remove the _Overlay files: find /opt/rt3/lib/ -type f -name '*_Overlay*' -delete RT has also changed how web deployment works; you will need to review -docs/web_deployment.pod for current instructions. The old -`fastcgi_server`, `webmux.pl`, and `mason_handler.*` files will not -work with RT 4.0, and should be removed to reduce confusion. +docs/web_deployment.pod for current instructions. The old `fastcgi_server`, +`webmux.pl`, and `mason_handler.*` files will not work with RT 4.0, and should +be removed to reduce confusion. + + +=head2 RT_SiteConfig.pm + +You will need to carefully review your local settings when moving from 3.8 to +4.0. -******* -RT_SiteConfig.pm +If you were adding your own custom statuses in earlier versions of RT, using +ActiveStatus or InactiveStatus you will need to port these to use the new +Lifecycles functionality. You can read more about it in RT_Config.pm. In +most cases, you can do this by extending the default active and inactive +lists. -You will need to carefully review your local settings when moving from -3.8 to 4.0. -If you were adding your own custom statuses in earlier versions of RT, -using ActiveStatus or InactiveStatus you will need to port these to use -the new Lifecycles functionality. You can read more about it in -RT_Config.pm. In most cases, you can do this by extending the default -active and inactive lists. +=head2 Upgrading sessions on MySQL -******* -Upgrading sessions on MySQL +In 4.0.0rc2, RT began shipping an updated schema for the sesions table that +specificies a character set as well as making the table InnoDB. As part of +the upgrade process, your sessions table will be dropped and recreated with +the new schema. -In 4.0.0rc2, RT began shipping an updated schema for the sesions table -that specificies a character set as well as making the table InnoDB. As -part of the upgrade process, your sessions table will be dropped and -recreated with the new schema. -******* -UPGRADING FROM RT 3.8.x and RTFM 2.1 or greater +=head2 Upgrading from installs with RTFM -RT4 now includes an Articles functionality, merged from RTFM. -You should not install and enable the RT::FM plugin separately on RT 4. -If you have existing data in RTFM, you can use the etc/upgrade/upgrade-articles -script to upgrade that data. +RT4 now includes an Articles functionality, merged from RTFM. You should not +install and enable the RT::FM plugin separately on RT 4. If you have existing +data in RTFM, you can use the etc/upgrade/upgrade-articles script to upgrade +that data. -When running normal upgrade scripts, RT will warn if it finds existing -RTFM tables that contain data and point you to the upgrade-articles script. +When running normal upgrade scripts, RT will warn if it finds existing RTFM +tables that contain data and point you to the upgrade-articles script. -This script should be run from your RT tarball. It will immediately -begin populating your new RT4 tables with data from RTFM. If you have -browsed in the RT4 UI and created new classes and articles, this script -will fail spectacularly. Do *not* run this except on a fresh upgrade of -RT. +This script should be run from your RT tarball. It will immediately begin +populating your new RT4 tables with data from RTFM. If you have browsed in +the RT4 UI and created new classes and articles, this script will fail +spectacularly. Do *not* run this except on a fresh upgrade of RT. You can run this as etc/upgrade/upgrade-articles -It will ouput a lot of data about what it is changing. You should -review this for errors. +It will ouput a lot of data about what it is changing. You should review this +for errors. -If you are running RTFM 2.0 with a release of RT, there isn't currently an upgrade -script that can port RTFM's internal CustomField and Transaction data to RT4. +If you are running RTFM 2.0 with a release of RT, there isn't currently an +upgrade script that can port RTFM's internal CustomField and Transaction data +to RT4. You must also remove RT::FM from your @Plugins line in RT_SiteConfig.pm. -******* -The deprecated classes RT::Action::Generic, RT::Condition::Generic and RT::Search::Generic -have been removed, but you shouldn't have been using them anyway. You should have been using -RT::Action, RT::Condition and RT::Search, respectively. -* The "Rights Delegation" and "Personal Groups" features have been removed. +=head2 Removals and updates + +The deprecated classes RT::Action::Generic, RT::Condition::Generic and +RT::Search::Generic have been removed, but you shouldn't have been using them +anyway. You should have been using RT::Action, RT::Condition and RT::Search, +respectively. + +=over + +=item * + +The "Rights Delegation" and "Personal Groups" features have been removed. -* Replace the following code in templates: +=item * + +Replace the following code in templates: [{$Ticket->QueueObj->SubjectTag || $rtname} #{$Ticket->id}] @@ -89,38 +101,45 @@ with { $Ticket->SubjectTag } -* Unique names are now enforced for user defined groups. New groups cannot be - created with a duplicate name and existing groups cannot be renamed to an - in-use name. The admin interface will warn about existing groups with - duplicate names. Although the groups will still function, some parts of the - interface (rights management, subgroup membership) may not work as expected - with duplicate names. Running +=item * + +Unique names are now enforced for user defined groups. New groups cannot be +created with a duplicate name and existing groups cannot be renamed to an +in-use name. The admin interface will warn about existing groups with +duplicate names. Although the groups will still function, some parts of the +interface (rights management, subgroup membership) may not work as expected +with duplicate names. Running /opt/rt4/sbin/rt-validator --check - will report duplicate group names, and running it with --resolve will fix - duplicates by appending the group id to the name. +will report duplicate group names, and running it with --resolve will fix +duplicates by appending the group id to the name. + +Nota Bene: As a result of differing indexes in the schema files, Postgres and +SQLite RT databases have enforced group name uniqueness for many years at the +database level. + +=back - Nota Bene: As a result of differing indexes in the schema files, Postgres and - SQLite RT databases have enforced group name uniqueness for many years at the - database level. -******* -UPGRADING FROM 4.0.5 and earlier - Changes: +=head1 UPGRADING FROM 4.0.5 AND EARLIER + +=head2 Schema updates The fix for an attribute truncation bug on MySQL requires a small ALTER TABLE. Be sure you run `make upgrade-database` to apply this change automatically. The bug primarily manifested when uploading large logos in the theme editor on -MySQL. Refer to etc/upgrade/4.0.6/schema.mysql for the actual ALTER TABLE that -will be run. +MySQL. Refer to etc/upgrade/4.0.6/schema.mysql for the actual ALTER TABLE +that will be run. + + +=head2 Query Builder -******* The web-based query builder now uses Queue limits to restrict the set of displayed statuses and owners. As part of this change, the %cfqueues -parameter was renamed to %Queues; if you have local modifications to any -of the following Mason templates, this feature will not function -correctly: +parameter was renamed to %Queues; if you have local modifications to any of +the following Mason templates, this feature will not function correctly: share/html/Elements/SelectOwner share/html/Elements/SelectStatus diff --git a/rt/docs/UPGRADING.mysql b/rt/docs/UPGRADING.mysql index 77a6b389f..a62dee78b 100644 --- a/rt/docs/UPGRADING.mysql +++ b/rt/docs/UPGRADING.mysql @@ -1,85 +1,142 @@ -If you did not start by reading the README file, please start there; -these steps do not list the full upgrading process, merely a part which -is sometimes necessary. +If you did not start by reading the README file, please start there; these +steps do not list the full upgrading process, merely a part which is sometimes +necessary. This file applies if either: - 1) You are upgrading RT from a version prior to 3.8.0, on any version - of MySQL -............. OR ............. - 2) You are migrating from MySQL 4.0 to MySQL 4.1 or above +=over + +=item 1. + +You are upgrading RT from a version prior to 3.8.0, on any version +of MySQL + +=item 2. + +You are migrating from MySQL 4.0 to MySQL 4.1 or above + +=back If neither of the above cases apply, your should upgrade as per the instructions in the README. -These changes are necessary because MySQL 4.1 and greater changed some -aspects of character set handling that may result in RT failures; this -will manifest as multiple login requests, corrupted binary attachments, -and corrupted image custom fields, among others. In order to resolve -this issue, the upgrade process will need to modify the schema. +These changes are necessary because MySQL 4.1 and greater changed some aspects +of character set handling that may result in RT failures; this will manifest +as multiple login requests, corrupted binary attachments, and corrupted image +custom fields, among others. In order to resolve this issue, the upgrade +process will need to modify the schema. + +=over + +=item 1. + +If you are moving the database and/or upgrading MySQL + +=over + +=item 1a. + +Dump the database; with MySQL 4.1 and greater be sure to pass the mysqldump +command the --default-character-set=binary option. This is necessary because +the data was originally encoded in Latin1. + +=item 1b. + +Configure the new MySQL to use Latin1 as the default character set everywhere, +not UTF-8. This is necessary so the import in the next step assumes the data +is Latin1. + +=item 1c. + +Import the dump made in step 1a into the new MySQL server, using the +--default-character-set=binary option on restore. This will ensure that the +data is imported as bytes, which will be interpreted as Latin1 thanks to step +1b above. + +=item 1d. + +Test that your RT works as expected on this new database. + +=back + +=item 2. + +Backup RT's database using --default-character-set=binary Furthermore, test +that you can restore from this backup. + +=item 3. + +Follow instructions in the README file to step 6b. + +=item 4. + +Apply changes described in the README's step 6b, but only up to version +3.7.87. + +=item 5. + +Apply the RT 3.8 schema upgrades. Included in RT is the script +etc/upgrade/upgrade-mysql-schema.pl that will generate the appropriate SQL +queries: + + perl etc/upgrade/upgrade-mysql-schema.pl db user pass > queries.sql + +If your mysql database is on a remote host, you can run the script like this +instead: + + perl etc/upgrade/upgrade-mysql-schema.pl db:host user pass > queries.sql + +=item 6. + +Check the sanity of the SQL queries in the queries.sql file yourself, or +consult with your DBA. + +=item 7. + +Apply the queries. Note that this step can take a while; it may also require +additional space on your hard drive comparable with size of your tables. - 1) If you are moving the database and/or upgrading MySQL - 1a) Dump the database; with MySQL 4.1 and greater be sure to pass - the mysqldump command the --default-character-set=binary option. - This is necessary because the data was originally encoded in - Latin1. + mysql -u root -p rt3 < queries.sql - 1b) Configure the new MySQL to use Latin1 as the default character - set everywhere, not UTF-8. This is necessary so the import in - the next step assumes the data is Latin1. +NOTE that 'rt3' is the default name of the RT database, change it in the +command above if your database is named differently. - 1c) Import the dump made in step 1a into the new MySQL server, using - the --default-character-set=binary option on restore. This will - ensure that the data is imported as bytes, which will be - interpreted as Latin1 thanks to step 1b above. +This step should not produce any errors or warnings. If you see any, restore +your database from the backup you made at step 1, and send a report to the +rt-users@lists.bestpractical.com mailing list. - 1d) Test that your RT works as expected on this new database. +=item 8. - 2) Backup RT's database using --default-character-set=binary - Furthermore, test that you can restore from this backup. +Re-run the `make upgrade-database` command from step 6b of the README, +applying the rest of the upgrades, starting with 3.7.87, and follow the +README's remaining steps. - 3) Follow instructions in the README file to step 6b. +=item 9. - 4) Apply changes described in the README's step 6b, but only up to - version 3.7.87. +Test everything. The most important parts you have to test: - 5) Apply the RT 3.8 schema upgrades. Included in RT is the script - etc/upgrade/upgrade-mysql-schema.pl that will generate the - appropriate SQL queries: +=over - perl etc/upgrade/upgrade-mysql-schema.pl db user pass > queries.sql +=item * - If your mysql database is on a remote host, you can run the script - like this instead: +binary attachments, like docs, PDFs, and images - perl etc/upgrade/upgrade-mysql-schema.pl db:host user pass > queries.sql +=item * - 6) Check the sanity of the SQL queries in the queries.sql file - yourself, or consult with your DBA. +binary custom fields - 7) Apply the queries. Note that this step can take a while; it may also - require additional space on your hard drive comparable with size of - your tables. +=item * - mysql -u root -p rt3 < queries.sql +everything that may contain characters other than ASCII - NOTE that 'rt3' is the default name of the RT database, change it in - the command above if your database is named differently. +=back - This step should not produce any errors or warnings. If you see any, - restore your database from the backup you made at step 1, and send a - report to the rt-users@lists.bestpractical.com mailing list. - 8) Re-run the `make upgrade-database` command from step 6b of the - README, applying the rest of the upgrades, starting with 3.7.87, and - follow the README's remaining steps. +=item 10. - 9) Test everything. The most important parts you have to test: - * binary attachments, like docs, PDFs, and images - * binary custom fields - * everything that may contain characters other than ASCII +If you were upgrading from MySQL 4.0, you may now, if you wish, reconfigure +your newer MySQL instance to use UTF-8 as the default character set, as step 7 +above adjusted the character sets on all existing tables to contain UTF-8 +encoded data, rather than Latin1. -10) If you were upgrading from MySQL 4.0, you may now, if you wish, - reconfigure your newer MySQL instance to use UTF-8 as the default - character set, as step 7 above adjusted the character sets on all - existing tables to contain UTF-8 encoded data, rather than Latin1. +=back diff --git a/rt/etc/RT_Config.pm.in b/rt/etc/RT_Config.pm.in index 169182033..5edb54c26 100644 --- a/rt/etc/RT_Config.pm.in +++ b/rt/etc/RT_Config.pm.in @@ -348,7 +348,8 @@ Set($StoreLoops, undef); =item C<$MaxAttachmentSize> C<$MaxAttachmentSize> sets the maximum size (in bytes) of attachments -stored in the database. +stored in the database. This setting is irrelevant unless one of +$TruncateLongAttachments or $DropLongAttachments (below) are set. =cut @@ -1766,12 +1767,12 @@ Set($ForceApprovalsView, 0); =head1 Extra security -=over 4 - This is a list of extra security measures to enable that help keep your RT safe. If you don't know what these mean, you should almost certainly leave the defaults alone. +=over 4 + =item C<$DisallowExecuteCode> If set to a true value, the C right will be removed from @@ -1816,7 +1817,7 @@ backwards compatability. Set($RestrictLoginReferrer, 0); -=item C<$ReferrerWhitelist> +=item C<@ReferrerWhitelist> This is a list of hostname:port combinations that RT will treat as being part of RT's domain. This is particularly useful if you access RT as @@ -2597,7 +2598,7 @@ Set(%AdminSearchResultFormat, Queues => q{'__id__/TITLE:#'} .q{,'__Name__/TITLE:Name'} - .q{,__Description__,__Address__,__Priority__,__DefaultDueIn__,'__Disabled__,__Lifecycle__}, + .q{,__Description__,__Address__,__Priority__,__DefaultDueIn__,__Disabled__,__Lifecycle__}, Groups => q{'__id__/TITLE:#'} @@ -2749,6 +2750,8 @@ Set($LinkTransactionsRun1Scrip, 0); This option has been deprecated. You can configure this site-wide with L (see L). +=back + =cut 1; diff --git a/rt/etc/upgrade/3.8.4/content b/rt/etc/upgrade/3.8.4/content index 38d551450..14ecba461 100644 --- a/rt/etc/upgrade/3.8.4/content +++ b/rt/etc/upgrade/3.8.4/content @@ -45,7 +45,7 @@ if ( my $struct = eval { Storable::thaw( $argument ) } ) { $new = $converter->( $struct ); } else { - $new = join /, /, grep length, split /[^0-9]+/, $argument; + $new = join ", ", grep length, split /[^0-9]+/, $argument; } next if $new eq $argument; diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index 4ae1a8b66..2a7a2e3c0 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -99,47 +99,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; - return ( abs $ret ); + if ($orig_message) { + $message->attach( + Type => 'application/x-rt-original-message', + Disposition => 'inline', + Data => $orig_message->as_string, + ); + } + $self->RecordOutgoingMailTransaction($message); + $self->RecordDeferredRecipients(); + return 1; } =head2 Prepare diff --git a/rt/lib/RT/Approval/Rule/Passed.pm b/rt/lib/RT/Approval/Rule/Passed.pm index f364bc926..000a8dc62 100644 --- a/rt/lib/RT/Approval/Rule/Passed.pm +++ b/rt/lib/RT/Approval/Rule/Passed.pm @@ -80,10 +80,8 @@ sub Commit { } } - $obj->SetStatus( - Status => $obj->QueueObj->Lifecycle->DefaultStatus('approved') || 'open', - Force => 1, - ); + $obj->SetStatus( Status => $obj->FirstActiveStatus, Force => 1 ) + if $obj->FirstActiveStatus; } my $passed = !$top->HasUnresolvedDependencies( Type => 'approval' ); @@ -98,6 +96,11 @@ sub Commit { $top->Correspond( MIMEObj => $template->MIMEObj ); if ($passed) { + my $new_status = $top->QueueObj->Lifecycle->DefaultStatus('approved') || 'open'; + if ( $new_status ne $top->Status ) { + $top->SetStatus( $new_status ); + } + $self->RunScripAction('Notify Owner', 'Approval Ready for Owner', TicketObj => $top); } diff --git a/rt/lib/RT/Article.pm b/rt/lib/RT/Article.pm index 24b952ad4..678aa1177 100644 --- a/rt/lib/RT/Article.pm +++ b/rt/lib/RT/Article.pm @@ -102,7 +102,7 @@ sub Create { @_ ); - my $class = RT::Class->new($RT::SystemUser); + my $class = RT::Class->new( $self->CurrentUser ); $class->Load( $args{'Class'} ); unless ( $class->Id ) { return ( 0, $self->loc('Invalid Class') ); diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm index fb17da3b5..f1d9a6342 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -600,8 +600,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); } @@ -617,9 +617,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); @@ -632,24 +630,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 @@ -676,6 +689,12 @@ sub _SplitHeaders { my $self = shift; my $headers = (shift || $self->_Value('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, $_; diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm index c5fb12bef..233047820 100644 --- a/rt/lib/RT/Crypt/GnuPG.pm +++ b/rt/lib/RT/Crypt/GnuPG.pm @@ -900,6 +900,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'; @@ -1064,9 +1077,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 ) { @@ -1083,9 +1100,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; @@ -2107,7 +2128,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; }; @@ -2301,7 +2324,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'} ) { diff --git a/rt/lib/RT/Generated.pm b/rt/lib/RT/Generated.pm index 9fd946f5b..907ea77f6 100644 --- a/rt/lib/RT/Generated.pm +++ b/rt/lib/RT/Generated.pm @@ -50,7 +50,7 @@ package RT; use warnings; use strict; -our $VERSION = '4.0.7'; +our $VERSION = '4.0.8'; diff --git a/rt/lib/RT/Handle.pm b/rt/lib/RT/Handle.pm index 99d10e367..03c262bba 100644 --- a/rt/lib/RT/Handle.pm +++ b/rt/lib/RT/Handle.pm @@ -858,26 +858,28 @@ sub InsertData { @queues = @{ delete $item->{'Queue'} }; } - my ( $return, $msg ) = $new_entry->Create(%$item); - unless( $return ) { - $RT::Logger->error( $msg ); - next; - } - if ( $item->{'BasedOn'} ) { - my $basedon = RT::CustomField->new($RT::SystemUser); - my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'}, - LookupType => $new_entry->LookupType ); - if ($ok) { - ($ok, $msg) = $new_entry->SetBasedOn( $basedon ); + if ( $item->{'LookupType'} ) { + my $basedon = RT::CustomField->new($RT::SystemUser); + my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'}, + LookupType => $item->{'LookupType'} ); if ($ok) { - $RT::Logger->debug("Added BasedOn $item->{BasedOn}: $msg"); + $item->{'BasedOn'} = $basedon->Id; } else { - $RT::Logger->error("Failed to add basedOn $item->{BasedOn}: $msg"); + $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF. Skipping BasedOn: $msg"); + delete $item->{'BasedOn'}; } } else { - $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF. Skipping BasedOn"); + $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified. Skipping BasedOn"); + delete $item->{'BasedOn'}; } + + } + + my ( $return, $msg ) = $new_entry->Create(%$item); + unless( $return ) { + $RT::Logger->error( $msg ); + next; } foreach my $value ( @{$values} ) { diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index 4c3ee9986..dda6f704a 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -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; } diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm index e508908fb..87a523dad 100755 --- a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm +++ b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm @@ -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 ); } diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 1aae7581e..745a6f1e3 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -304,12 +304,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)); } } } @@ -364,7 +364,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. Returns @@ -373,24 +373,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, setting the value of L 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); @@ -405,8 +449,9 @@ calls L 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 @@ -606,7 +651,8 @@ sub AttemptExternalAuth { $user =~ s/^\Q$NodeName\E\\//i; } - my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''}; + 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); @@ -645,7 +691,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(); } @@ -668,13 +714,13 @@ sub AttemptExternalAuth { $user = $orig_user; unless ( RT->Config->Get('WebFallbackToInternalAuth') ) { - TangentForLoginWithError('You are not an authorized user'); + 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 { @@ -705,7 +751,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; @@ -1201,6 +1248,13 @@ our %is_whitelisted_component = ( '/m/tickets/search' => 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; @@ -1223,6 +1277,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. @@ -1419,6 +1477,30 @@ 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'/Articles/' => "update an article", # 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/; @@ -1645,9 +1727,8 @@ sub CreateTicket { } } - foreach my $argument (qw(Encrypt Sign)) { - $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ) - if defined $ARGS{$argument}; + for my $argument (qw(Encrypt Sign)) { + $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ); } my %create_args = ( diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm index 6b351e94b..045df1fa0 100644 --- a/rt/lib/RT/Interface/Web/Menu.pm +++ b/rt/lib/RT/Interface/Web/Menu.pm @@ -150,10 +150,12 @@ treated as relative to it's parent's path, and made absolute. sub path { my $self = shift; if (@_) { - $self->{path} = shift; - $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string - if defined $self->{path} and $self->parent and $self->parent->path; - $self->{path} =~ s!///!/! if $self->{path}; + if (defined($self->{path} = shift)) { + my $base = ($self->parent and $self->parent->path) ? $self->parent->path : ""; + $base .= "/" unless $base =~ m{/$}; + my $uri = URI->new_abs($self->{path}, $base); + $self->{path} = $uri->as_string; + } } return $self->{path}; } @@ -230,6 +232,7 @@ sub child { if ( defined $path and length $path ) { my $base_path = $HTML::Mason::Commands::r->path_info; my $query = $HTML::Mason::Commands::m->cgi_object->query_string; + $base_path =~ s!/+!/!g; $base_path .= "?$query" if defined $query and length $query; $base_path =~ s/index\.html$//; diff --git a/rt/lib/RT/Pod/HTML.pm b/rt/lib/RT/Pod/HTML.pm new file mode 100644 index 000000000..8ddce42d1 --- /dev/null +++ b/rt/lib/RT/Pod/HTML.pm @@ -0,0 +1,66 @@ +use strict; +use warnings; + +package RT::Pod::HTML; +use base 'Pod::Simple::XHTML'; + +sub new { + my $self = shift->SUPER::new(@_); + $self->index(1); + $self->anchor_items(1); + return $self; +} + +sub perldoc_url_prefix { "http://metacpan.org/module/" } + +sub html_header { '' } +sub html_footer { + my $self = shift; + my $toc = "../" x ($self->batch_mode_current_level - 1); + return '← Back to index'; +} + +sub start_Verbatim { $_[0]{'scratch'} = "
    " }
+sub end_Verbatim   { $_[0]{'scratch'} .= "
    "; $_[0]->emit; } + +sub _end_head { + my $self = shift; + $self->{scratch} = '' . $self->{scratch} . ''; + return $self->SUPER::_end_head(@_); +} + +sub resolve_pod_page_link { + my $self = shift; + my ($name, $section) = @_; + + # Only try to resolve local links if we're in batch mode and are linking + # outside the current document. + return $self->SUPER::resolve_pod_page_link(@_) + unless $self->batch_mode and $name; + + $section = defined $section + ? '#' . $self->idify($section, 1) + : ''; + + my $local; + if ($name =~ /^RT::/) { + $local = join "/", + map { $self->encode_entities($_) } + split /::/, $name; + } + elsif ($name =~ /^rt-/) { + $local = $self->encode_entities($name); + } + + if ($local) { + # Resolve links correctly by going up + my $depth = $self->batch_mode_current_level - 1; + return join "/", + ($depth ? ".." x $depth : ()), + "$local.html$section"; + } else { + return $self->SUPER::resolve_pod_page_link(@_) + } +} + +1; diff --git a/rt/lib/RT/Pod/HTMLBatch.pm b/rt/lib/RT/Pod/HTMLBatch.pm new file mode 100644 index 000000000..8d1b67f34 --- /dev/null +++ b/rt/lib/RT/Pod/HTMLBatch.pm @@ -0,0 +1,131 @@ +use strict; +use warnings; + +package RT::Pod::HTMLBatch; +use base 'Pod::Simple::HTMLBatch'; + +use List::MoreUtils qw/all/; + +use RT::Pod::Search; +use RT::Pod::HTML; + +sub new { + my $self = shift->SUPER::new(@_); + $self->verbose(0); + + # Per-page output options + $self->css_flurry(0); # No CSS + $self->javascript_flurry(0); # No JS + $self->no_contents_links(1); # No header/footer "Back to contents" links + + # TOC options + $self->index(1); # Write a per-page TOC + $self->contents_file("index.html"); # Write a global TOC + + $self->html_render_class('RT::Pod::HTML'); + $self->search_class('RT::Pod::Search'); + + return $self; +} + +sub classify { + my $self = shift; + my %info = (@_); + + my $is_install_doc = sub { + my %page = @_; + local $_ = $page{name}; + return 1 if /^(README|UPGRADING)/; + return 1 if $_ eq "RT_Config"; + return 1 if $_ eq "web_deployment"; + return 1 if $page{infile} =~ m{^configure(\.ac)?$}; + return 0; + }; + + my $section = $info{infile} =~ m{/plugins/([^/]+)} ? "05 Extension: $1" : + $info{infile} =~ m{/local/} ? '04 Local Documenation' : + $is_install_doc->(%info) ? '00 Install and Upgrade '. + 'Documentation' : + $info{infile} =~ m{/(docs|etc)/} ? '01 User Documentation' : + $info{infile} =~ m{/bin/} ? '02 Utilities (bin)' : + $info{infile} =~ m{/sbin/} ? '03 Utilities (sbin)' : + $info{name} =~ /^RT::Action/ ? '08 Actions' : + $info{name} =~ /^RT::Condition/ ? '09 Conditions' : + $info{name} =~ /^RT(::|$)/ ? '07 Developer Documentation' : + $info{infile} =~ m{/devel/tools/} ? '20 Utilities (devel/tools)' : + '06 Miscellaneous' ; + + if ($info{infile} =~ m{/(docs|etc)/}) { + $info{name} =~ s/_/ /g; + $info{name} = join "/", map { ucfirst } split /::/, $info{name}; + } + + return ($info{name}, $section); +} + +sub write_contents_file { + my ($self, $to) = @_; + return unless $self->contents_file; + + my $file = join "/", $to, $self->contents_file; + open my $index, ">", $file + or warn "Unable to open index file '$file': $!\n", return; + + my $pages = $self->_contents; + return unless @$pages; + + # Classify + my %toc; + for my $page (@$pages) { + my ($name, $infile, $outfile, $pieces) = @$page; + + my ($title, $section) = $self->classify( + name => $name, + infile => $infile, + ); + + (my $path = $outfile) =~ s{^\Q$to\E/?}{}; + + push @{ $toc{$section} }, { + name => $title, + path => $path, + }; + } + + # Write out index + print $index "
    \n"; + + for my $key (sort keys %toc) { + next unless @{ $toc{$key} }; + + (my $section = $key) =~ s/^\d+ //; + print $index "
    ", esc($section), "
    \n"; + print $index "
    \n"; + + my @sorted = sort { + my @names = map { $_->{name} } $a, $b; + + # Sort just the upgrading docs descending within everything else + @names = reverse @names + if all { /^UPGRADING-/ } @names; + + $names[0] cmp $names[1] + } @{ $toc{$key} }; + + for my $page (@sorted) { + print $index " ", + esc($page->{name}), + "
    \n"; + } + print $index "
    \n"; + } + print $index '
    '; + + close $index; +} + +sub esc { + Pod::Simple::HTMLBatch::esc(@_); +} + +1; diff --git a/rt/lib/RT/Pod/Search.pm b/rt/lib/RT/Pod/Search.pm new file mode 100644 index 000000000..d6ddd2daf --- /dev/null +++ b/rt/lib/RT/Pod/Search.pm @@ -0,0 +1,15 @@ +use strict; +use warnings; + +package RT::Pod::Search; +use base 'Pod::Simple::Search'; + +sub new { + my $self = shift->SUPER::new(@_); + $self->laborious(1) # Find scripts too + ->limit_re(qr/(?inc(0); # Don't look in @INC + return $self; +} + +1; diff --git a/rt/lib/RT/Queue.pm b/rt/lib/RT/Queue.pm index 406df9214..a942bb6d7 100755 --- a/rt/lib/RT/Queue.pm +++ b/rt/lib/RT/Queue.pm @@ -394,6 +394,7 @@ sub Create { FinalPriority => 0, DefaultDueIn => 0, Sign => undef, + SignAuto => undef, Encrypt => undef, _RecordTransaction => 1, @_ @@ -436,14 +437,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; } @@ -595,6 +593,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; diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index fd238de16..313888cbc 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -1483,8 +1483,35 @@ sub _DeleteLink { } +=head1 LockForUpdate +In a database transaction, gains an exclusive lock on the row, to +prevent race conditions. On SQLite, this is a "RESERVED" lock on the +entire database. +=cut + +sub LockForUpdate { + my $self = shift; + + my $pk = $self->_PrimaryKey; + my $id = @_ ? $_[0] : $self->$pk; + $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable"); + if (RT->Config->Get('DatabaseType') eq "SQLite") { + # SQLite does DB-level locking, upgrading the transaction to + # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op + # UPDATE to force the upgade. + return RT->DatabaseHandle->dbh->do( + "UPDATE " .$self->Table. + " SET $pk = $pk WHERE 1 = 0"); + } else { + return $self->_LoadFromSQL( + "SELECT * FROM ".$self->Table + ." WHERE $pk = ? FOR UPDATE", + $id, + ); + } +} =head2 _NewTransaction PARAMHASH @@ -1512,6 +1539,11 @@ sub _NewTransaction { @_ ); + my $in_txn = RT->DatabaseHandle->TransactionDepth; + RT->DatabaseHandle->BeginTransaction unless $in_txn; + + $self->LockForUpdate; + my $old_ref = $args{'OldReference'}; my $new_ref = $args{'NewReference'}; my $ref_type = $args{'ReferenceType'}; @@ -1559,6 +1591,9 @@ sub _NewTransaction { if ( RT->Config->Get('UseTransactionBatch') and $transaction ) { push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; } + + RT->DatabaseHandle->Commit unless $in_txn; + return ( $transaction, $msg, $trans ); } diff --git a/rt/lib/RT/Template.pm b/rt/lib/RT/Template.pm index 117cc3f1c..e509454b1 100755 --- a/rt/lib/RT/Template.pm +++ b/rt/lib/RT/Template.pm @@ -390,6 +390,7 @@ sub _Parse { # Unfold all headers $self->{'MIMEObj'}->head->unfold; + $self->{'MIMEObj'}->head->modify(1); return ( 1, $self->loc("Template parsed") ); diff --git a/rt/lib/RT/Ticket.pm b/rt/lib/RT/Ticket.pm index 577c44429..5f76e055f 100755 --- a/rt/lib/RT/Ticket.pm +++ b/rt/lib/RT/Ticket.pm @@ -2199,14 +2199,16 @@ sub Comment { } $args{'NoteType'} = 'Comment'; + $RT::Handle->BeginTransaction(); if ($args{'DryRun'}) { - $RT::Handle->BeginTransaction(); $args{'CommitScrips'} = 0; } my @results = $self->_RecordNote(%args); if ($args{'DryRun'}) { $RT::Handle->Rollback(); + } else { + $RT::Handle->Commit(); } return(@results); @@ -2245,10 +2247,10 @@ sub Correspond { or ( $self->CurrentUserHasRight('ModifyTicket') ) ) { return ( 0, $self->loc("Permission Denied"), undef ); } + $args{'NoteType'} = 'Correspond'; - $args{'NoteType'} = 'Correspond'; + $RT::Handle->BeginTransaction(); if ($args{'DryRun'}) { - $RT::Handle->BeginTransaction(); $args{'CommitScrips'} = 0; } @@ -2265,6 +2267,8 @@ sub Correspond { if ($args{'DryRun'}) { $RT::Handle->Rollback(); + } else { + $RT::Handle->Commit(); } return (@results); diff --git a/rt/lib/RT/User.pm b/rt/lib/RT/User.pm index e7f7c2ad6..f26ace445 100755 --- a/rt/lib/RT/User.pm +++ b/rt/lib/RT/User.pm @@ -102,6 +102,7 @@ sub _OverlayAccessible { AuthSystem => { public => 1, admin => 1 }, Gecos => { public => 1, admin => 1 }, PGPKey => { public => 1, admin => 1 }, + PrivateKey => { admin => 1 }, } } diff --git a/rt/sbin/rt-fulltext-indexer b/rt/sbin/rt-fulltext-indexer index 2a6b07e39..396ef10bd 100755 --- a/rt/sbin/rt-fulltext-indexer +++ b/rt/sbin/rt-fulltext-indexer @@ -217,6 +217,11 @@ sub attachments { VALUE => 'deleted' ); + # On newer DBIx::SearchBuilder's, indicate that making the query DISTINCT + # is unnecessary because the joins won't produce duplicates. This + # drastically improves performance when fetching attachments. + $res->{joins_are_distinct} = 1; + return goto_specific( suffix => $type, error => "Don't know how to find $type attachments", diff --git a/rt/sbin/rt-fulltext-indexer.in b/rt/sbin/rt-fulltext-indexer.in index 7e31cac84..06aa89270 100644 --- a/rt/sbin/rt-fulltext-indexer.in +++ b/rt/sbin/rt-fulltext-indexer.in @@ -217,6 +217,11 @@ sub attachments { VALUE => 'deleted' ); + # On newer DBIx::SearchBuilder's, indicate that making the query DISTINCT + # is unnecessary because the joins won't produce duplicates. This + # drastically improves performance when fetching attachments. + $res->{joins_are_distinct} = 1; + return goto_specific( suffix => $type, error => "Don't know how to find $type attachments", diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in index 960d640c3..5ce918b02 100644 --- a/rt/sbin/rt-test-dependencies.in +++ b/rt/sbin/rt-test-dependencies.in @@ -75,6 +75,7 @@ GetOptions( 'with-DASHBOARDS', 'with-USERLOGO', 'with-SSL-MAILGATE', + 'with-HTML-DOC', 'download=s', 'repository=s', @@ -104,6 +105,7 @@ my %default = ( 'with-DASHBOARDS' => 1, 'with-USERLOGO' => 1, 'with-SSL-MAILGATE' => @RT_SSL_MAILGATE@, + 'with-HTML-DOC' => @RT_DEVEL_MODE@, ); $args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default; @@ -358,6 +360,11 @@ $deps{'USERLOGO'} = [ text_to_hash( << '.') ]; Convert::Color . +$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ]; +Pod::Simple 3.17 +HTML::Entities +. + my %AVOID = ( 'DBD::Oracle' => [qw(1.23)], 'Email::Address' => [qw(1.893 1.894)], diff --git a/rt/sbin/rt-validate-aliases.in b/rt/sbin/rt-validate-aliases.in new file mode 100644 index 000000000..46ae8aac7 --- /dev/null +++ b/rt/sbin/rt-validate-aliases.in @@ -0,0 +1,343 @@ +#!@PERL@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +use warnings; +use Text::ParseWords qw//; +use Getopt::Long; + +BEGIN { # BEGIN RT CMD BOILERPLATE + require File::Spec; + require Cwd; + my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1]; + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +require RT; +RT::LoadConfig(); +RT::Init(); + +my ($PREFIX, $URL, $HOST) = (""); +GetOptions( + "prefix|p=s" => \$PREFIX, + "url|u=s" => \$URL, + "host|h=s" => \$HOST, +); + +unless (@ARGV) { + @ARGV = grep {-f} ("/etc/aliases", + "/etc/mail/aliases", + "/etc/postfix/aliases"); + die "Can't determine aliases file to parse!" + unless @ARGV; +} + +my %aliases = parse_lines(); +unless (%aliases) { + warn "No mailgate aliases found in @ARGV"; + exit; +} + +my %seen; +my $global_mailgate; +for my $address (sort keys %aliases) { + my ($mailgate, $opts, $extra) = @{$aliases{$address}}; + my %opts = %{$opts}; + + next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/; + + if ($mailgate !~ /^\|/) { + warn "Missing the leading | on alias $address\n"; + $mailgate = "|$mailgate"; + } + if (($global_mailgate ||= $mailgate) ne $mailgate) { + warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n"; + } + + if (not defined $opts{action}) { + warn "Missing --action parameter for alias $address\n"; + } elsif ($opts{action} !~ /^(correspond|comment)$/) { + warn "Invalid --action parameter for alias $address: $opts{action}\n" + } + + my $queue = RT::Queue->new( RT->SystemUser ); + if (not defined $opts{queue}) { + warn "Missing --queue parameter for alias $address\n"; + } else { + $queue->Load( $opts{queue} ); + if (not $queue->id) { + warn "Invalid --queue parameter for alias $address: $opts{queue}\n"; + } elsif ($queue->Disabled) { + warn "Disabled --queue given for alias $address: $opts{queue}\n"; + } + } + + if (not defined $opts{url}) { + warn "Missing --url parameter for alias $address\n"; + } #XXX: Test connectivity and/or https certs? + + if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) { + push @{$seen{lc $queue->Name}{$opts{action}}}, $address; + } + + warn "Unknown extra arguments for alias $address: @{$extra}\n" + if @{$extra}; +} + +# Check the global settings +my %global; +for my $action (qw/correspond comment/) { + my $setting = ucfirst($action) . "Address"; + my $value = RT->Config->Get($setting); + if (not defined $value) { + warn "$setting is not set!\n"; + next; + } + my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/; + next if $HOST and $host !~ /\Q$HOST\E/; + $local = "$PREFIX$local" unless exists $aliases{$local}; + + $global{$setting} = $local; + if (not exists $aliases{$local}) { + warn "$setting $value does not exist in aliases!\n" + } elsif ($aliases{$local}[1]{action} ne $action) { + warn "$setting $value is a $aliases{$local}[1]{action} in aliases!" + } +} +warn "CorrespondAddress and CommentAddress are the same!\n" + if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress"); + + +# Go through the queues, one at a time +my $queues = RT::Queues->new( RT->SystemUser ); +$queues->UnLimit; +while (my $q = $queues->Next) { + my $qname = $q->Name; + for my $action (qw/correspond comment/) { + my $setting = ucfirst($action) . "Address"; + my $value = $q->$setting; + + if (not $value) { + my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []}; + warn "CorrespondAddress not set on $qname, but in aliases as " + .join(" and ", @other) . "\n" if @other; + next; + } + + if ($action eq "comment" and $q->CorrespondAddress + and $q->CorrespondAddress eq $q->CommentAddress) { + warn "CorrespondAddress and CommentAddress are set the same on $qname\n"; + next; + } + + my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/; + next if $HOST and $host !~ /\Q$HOST\E/; + $local = "$PREFIX$local" unless exists $aliases{$local}; + + my @other = @{$seen{lc $q->Name}{$action} || []}; + if (not exists $aliases{$local}) { + if (@other) { + warn "$setting $value on $qname does not exist in aliases -- typo'd as " + .join(" or ", @other) . "?\n"; + } else { + warn "$setting $value on $qname does not exist in aliases!\n" + } + next; + } + + my %opt = %{$aliases{$local}[1]}; + if ($opt{action} ne $action) { + warn "$setting address $value on $qname is a $opt{action} in aliases!\n" + } + if (lc $opt{queue} ne lc $q->Name and $action ne "comment") { + warn "$setting address $value on $qname points to queue $opt{queue} in aliases!\n"; + } + + @other = grep {$_ ne $local} @other; + warn "Extra aliases for queue $qname: ".join(",",@other)."\n" + if @other; + } +} + + +sub parse_lines { + local @ARGV = @ARGV; + + my %aliases; + my $line = ""; + for (<>) { + next unless /\S/; + next if /^#/; + chomp; + if (/^\s+/) { + $line .= $_; + } else { + add_line($line, \%aliases); + $line = $_; + } + } + add_line($line, \%aliases); + + expand(\%aliases); + filter_mailgate(\%aliases); + + return %aliases; +} + +sub expand { + my ($data) = @_; + + for (1..100) { + my $expanded = 0; + for my $address (sort keys %{$data}) { + my @new; + for my $part (@{$data->{$address}}) { + if (m!^[|/]! or not $data->{$part}) { + push @new, $part; + } else { + $expanded++; + push @new, @{$data->{$part}}; + } + } + $data->{$address} = \@new; + } + return unless $expanded; + } + warn "Recursion limit exceeded -- cycle in aliases?\n"; +} + +sub filter_mailgate { + my ($data) = @_; + + for my $address (sort keys %{$data}) { + my @parts = @{delete $data->{$address}}; + + my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts; + next unless @pipes; + + my $pipe = shift @pipes; + warn "More than one rt-mailgate pipe for alias: $address\n" + if @pipes; + + my @args = Text::ParseWords::shellwords($pipe); + + # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...", + # we just need to strip off enough + my $index = 0; + $index++ while $args[$index] !~ m!/rt-mailgate!; + my $mailgate = join(' ', splice(@args,0,$index+1)); + + my %opts; + local @ARGV = @args; + Getopt::Long::Configure( "pass_through" ); # Allow unknown options + my $ret = eval { + GetOptions( \%opts, "queue=s", "action=s", "url=s", + "jar=s", "debug", "extension=s", + "timeout=i", "verify-ssl!", "ca-file=s", + ); + 1; + }; + warn "Failed to parse options for $address: $@" unless $ret; + next unless %opts; + + $data->{lc $address} = [$mailgate, \%opts, [@ARGV]]; + } +} + +sub add_line { + my ($line, $data) = @_; + return unless $line =~ /\S/; + + my ($name, $parts) = parse_line($line); + return unless defined $name; + + if (defined $data->{$name}) { + warn "Duplicate definition for alias $name\n"; + return; + } + + $data->{lc $name} = $parts; +} + +sub parse_line { + my $re_name = qr/\S+/; + # Intentionally accept pipe-like aliases with a missing | -- we deal with them later + my $re_quoted_pipe = qr/"\|?[^\\"]*(?:\\[\\"][^\\"]*)*"/; + my $re_nonquoted_pipe = qr/\|[^\s,]+/; + my $re_pipe = qr/(?:$re_quoted_pipe|$re_nonquoted_pipe)/; + my $re_path = qr!/[^,\s]+!; + my $re_address = qr![^|/,\s][^,\s]*!; + my $re_value = qr/(?:$re_pipe|$re_path|$re_address)/; + my $re_values = qr/(?:$re_value(?:\s*,\s*$re_value)*)/; + + my ($line) = @_; + if ($line =~ /^($re_name):\s*($re_values)/) { + my ($name, $all_parts) = ($1, $2); + my @parts; + while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) { + my $part = $1; + if ($part =~ /^"/) { + $part =~ s/^"//; $part =~ s/"$//; + $part =~ s/\\(.)/$1/g; + } + push @parts, $part; + } + return $name, [@parts]; + } else { + warn "Parse failure, line $. of $ARGV: $line\n"; + return (); + } +} diff --git a/rt/share/html/Admin/Groups/Modify.html b/rt/share/html/Admin/Groups/Modify.html index 148c98e1f..4491a71c8 100755 --- a/rt/share/html/Admin/Groups/Modify.html +++ b/rt/share/html/Admin/Groups/Modify.html @@ -162,10 +162,7 @@ MaybeRedirectForResults( push @results, @warnings; -unless ($Group->Disabled()) { - $EnabledChecked ='checked="checked"'; -} - +$EnabledChecked = ( $Group->Disabled() ? '' : 'checked="checked"' ); diff --git a/rt/share/html/Admin/Queues/Modify.html b/rt/share/html/Admin/Queues/Modify.html index 85cd62f16..c2cf09422 100755 --- a/rt/share/html/Admin/Queues/Modify.html +++ b/rt/share/html/Admin/Queues/Modify.html @@ -119,6 +119,8 @@ Encrypt? 'checked="checked"': '' |n%> /> <&|/l&>Encrypt by default +SignAuto? 'checked="checked"': '' |n%> /> +<&|/l_unsafe, "","","",""&>Sign all auto-generated mail. [_1]Caution[_2]: Enabling this option alters the signature from providing [_3]authentication[_4] to providing [_3]integrity[_4]. % } /> @@ -181,13 +183,13 @@ unless ($Create) { if ( $QueueObj->Id ) { $title = loc('Configuration for queue [_1]', $QueueObj->Name ); my @attribs= qw(Description CorrespondAddress CommentAddress Name - InitialPriority FinalPriority DefaultDueIn Sign Encrypt Lifecycle SubjectTag Disabled); + InitialPriority FinalPriority DefaultDueIn Sign SignAuto Encrypt Lifecycle 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); } $m->callback( diff --git a/rt/share/html/Admin/Users/GnuPG.html b/rt/share/html/Admin/Users/GnuPG.html index 90408e449..ee58c4485 100644 --- a/rt/share/html/Admin/Users/GnuPG.html +++ b/rt/share/html/Admin/Users/GnuPG.html @@ -64,7 +64,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'), &> @@ -91,7 +91,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', @@ -100,8 +101,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); diff --git a/rt/share/html/Elements/CSRF b/rt/share/html/Elements/CSRF index 4893c1216..a3c19430e 100644 --- a/rt/share/html/Elements/CSRF +++ b/rt/share/html/Elements/CSRF @@ -52,11 +52,11 @@ % my $strong_start = ""; % my $strong_end = ""; -

    <&|/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.

    +

    <&|/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.

    % my $start = qq||; % my $end = qq||; -

    <&|/l_unsafe, $escaped_path, $start, $end &>If you really intended to visit [_1], then [_2]click here to resume your request[_3].

    +

    <&|/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].

    <& /Elements/Footer, %ARGS &> % $m->abort; @@ -71,4 +71,6 @@ $escaped_path = "$escaped_path"; 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"); diff --git a/rt/share/html/Elements/GnuPG/SignEncryptWidget b/rt/share/html/Elements/GnuPG/SignEncryptWidget index 0ae0f841f..2f3f1035d 100644 --- a/rt/share/html/Elements/GnuPG/SignEncryptWidget +++ b/rt/share/html/Elements/GnuPG/SignEncryptWidget @@ -129,12 +129,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 { diff --git a/rt/share/html/Elements/Login b/rt/share/html/Elements/Login index b86bfef16..b3f1a24ab 100755 --- a/rt/share/html/Elements/Login +++ b/rt/share/html/Elements/Login @@ -61,6 +61,8 @@
    <&| /Widgets/TitleBox, title => loc('Login'), titleright => $RT::VERSION, hideable => 0 &> +<& LoginRedirectWarning, %ARGS &> + % unless (RT->Config->Get('WebExternalAuth') and !RT->Config->Get('WebFallbackToInternalAuth')) {
    diff --git a/rt/share/html/Elements/LoginRedirectWarning b/rt/share/html/Elements/LoginRedirectWarning new file mode 100644 index 000000000..891e38114 --- /dev/null +++ b/rt/share/html/Elements/LoginRedirectWarning @@ -0,0 +1,20 @@ +<%args> +$next => undef + +<%init> +return unless $next; + +my $destination = RT::Interface::Web::FetchNextPage($next); +return unless ref $destination and $destination->{'HasSideEffects'}; + +my $consequence = RT::Interface::Web::PotentialPageAction($destination->{'url'}) || loc("perform actions"); + $consequence = $m->interp->apply_escapes($consequence => "h"); + +
    +

    + <&|/l&>After logging in you'll be sent to your original destination: + <% $destination->{'url'} %> + <&|/l_unsafe, "$consequence" &>which may [_1] on your behalf. +

    +

    <&|/l&>If this is not what you expect, leave this page now without logging in.

    +
    diff --git a/rt/share/html/Elements/Tabs b/rt/share/html/Elements/Tabs index 3aac9d803..d899071fa 100755 --- a/rt/share/html/Elements/Tabs +++ b/rt/share/html/Elements/Tabs @@ -51,6 +51,7 @@ #my $request_path = $HTML::Mason::Commands::r->path_info; my $request_path = $m->request_comp->path; +$request_path =~ s!/{2,}!/!g; my $query_string = sub { my %args = @_; diff --git a/rt/share/html/NoAuth/css/base/login.css b/rt/share/html/NoAuth/css/base/login.css index bd05a2845..608ebf87f 100644 --- a/rt/share/html/NoAuth/css/base/login.css +++ b/rt/share/html/NoAuth/css/base/login.css @@ -100,3 +100,11 @@ margin-right:auto;margin-left:auto; padding-left: 1em; } +.redirect-warning tt { + display: block; + margin: 0.5em 0 0.5em 1em; + white-space: nowrap; + overflow: hidden; + text-overflow: ellipsis; + width: 90%; +} diff --git a/rt/share/html/NoAuth/iCal/dhandler b/rt/share/html/NoAuth/iCal/dhandler index c86f4cf7b..0e9e81204 100644 --- a/rt/share/html/NoAuth/iCal/dhandler +++ b/rt/share/html/NoAuth/iCal/dhandler @@ -94,7 +94,7 @@ while (my $t = $tickets->Next) { my $start = Data::ICal::Entry::Event->new; my $end = Data::ICal::Entry::Event->new; $_->add_properties( - url => RT->Config->Get('WebURL') . "?q=".$t->id, + url => RT->Config->Get('WebURL') . "Ticket/Display.html?id=".$t->id, organizer => $t->OwnerObj->Name, dtstamp => $now->iCal, created => $t->CreatedObj->iCal, diff --git a/rt/share/html/Ticket/Elements/ShowMessageHeaders b/rt/share/html/Ticket/Elements/ShowMessageHeaders index 3c86162b1..5a91668c1 100755 --- a/rt/share/html/Ticket/Elements/ShowMessageHeaders +++ b/rt/share/html/Ticket/Elements/ShowMessageHeaders @@ -80,6 +80,11 @@ foreach my $f (@headers) { $m->comp('/Elements/MakeClicky', content => \$f->{'Value'}, ticket => $ticket, %ARGS); } +$m->callback( + CallbackName => 'BeforeLocalization', + headers => \@headers, +); + if ( $Localize ) { $_->{'Tag'} = loc($_->{'Tag'}) foreach @headers; } diff --git a/rt/t/mail/gnupg-incoming.t b/rt/t/mail/gnupg-incoming.t index e591add6c..6ff4f76ef 100644 --- a/rt/t/mail/gnupg-incoming.t +++ b/rt/t/mail/gnupg-incoming.t @@ -11,7 +11,7 @@ BEGIN { } use RT::Test::GnuPG - tests => 41, + tests => 49, actual_server => 1, gnupg_options => { passphrase => 'rt-test', @@ -20,6 +20,7 @@ use RT::Test::GnuPG use String::ShellQuote 'shell_quote'; use IPC::Run3 'run3'; +use MIME::Base64; my ($baseurl, $m) = RT::Test->started_ok; @@ -196,6 +197,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 = ''; diff --git a/rt/t/web/crypt-gnupg.t b/rt/t/web/crypt-gnupg.t index 8c0eb570d..b30edc3d8 100644 --- a/rt/t/web/crypt-gnupg.t +++ b/rt/t/web/crypt-gnupg.t @@ -8,6 +8,7 @@ use RT::Test::GnuPG 'trust-model' => 'always', }; use Test::Warn; +use MIME::Head; use RT::Action::SendEmail; @@ -70,8 +71,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"; @@ -139,8 +139,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"; @@ -212,8 +211,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"; @@ -279,8 +277,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"; @@ -326,6 +323,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; diff --git a/rt/t/web/ticket_forward.t b/rt/t/web/ticket_forward.t index 1d74673de..0c411b99f 100644 --- a/rt/t/web/ticket_forward.t +++ b/rt/t/web/ticket_forward.t @@ -49,7 +49,7 @@ diag "Forward Ticket" if $ENV{TEST_VERBOSE}; my ($mail) = RT::Test->fetch_caught_mails; like( $mail, qr!Subject: test forward!, 'Subject field' ); like( $mail, qr!To: rt-test, rt-to\@example.com!, 'To field' ); - like( $mail, qr!Cc: rt-cc\@example.com!, 'Cc field' ); + like( $mail, qr!Cc: rt-cc\@example.com!i, 'Cc field' ); like( $mail, qr!This is a forward of ticket!, 'content' ); like( $mail, qr!this is an attachment!, 'att content' ); like( $mail, qr!$att_name!, 'att file name' ); @@ -75,8 +75,8 @@ qr/Forwarded Transaction #\d+ to rt-test, rt-to\@example.com, rt-cc\@example.com my ($mail) = RT::Test->fetch_caught_mails; like( $mail, qr!Subject: test forward!, 'Subject field' ); like( $mail, qr!To: rt-test, rt-to\@example.com!, 'To field' ); - like( $mail, qr!Cc: rt-cc\@example.com!, 'Cc field' ); - like( $mail, qr!Bcc: rt-bcc\@example.com!, 'Bcc field' ); + like( $mail, qr!Cc: rt-cc\@example.com!i, 'Cc field' ); + like( $mail, qr!Bcc: rt-bcc\@example.com!i, 'Bcc field' ); like( $mail, qr!This is a forward of transaction!, 'content' ); like( $mail, qr!$att_name!, 'att file name' ); like( $mail, qr!this is an attachment!, 'att content' );