diff options
204 files changed, 45761 insertions, 1157 deletions
diff --git a/rt/Makefile b/rt/Makefile new file mode 100644 index 000000000..1ad55304f --- /dev/null +++ b/rt/Makefile @@ -0,0 +1,572 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} +# +# DO NOT HAND-EDIT the file named 'Makefile'. This file is autogenerated. +# Have a look at "configure" and "Makefile.in" instead +# + + +PERL = /usr/bin/perl +INSTALL = /usr/bin/install -c +CC = @CC@ + +RT_LAYOUT = Freeside + +CONFIG_FILE_PATH = /opt/rt3/etc +CONFIG_FILE = $(CONFIG_FILE_PATH)/RT_Config.pm +SITE_CONFIG_FILE = $(CONFIG_FILE_PATH)/RT_SiteConfig.pm + + +RT_VERSION_MAJOR = 4 +RT_VERSION_MINOR = 0 +RT_VERSION_PATCH = 22 + +RT_VERSION = $(RT_VERSION_MAJOR).$(RT_VERSION_MINOR).$(RT_VERSION_PATCH) +TAG = rt-$(RT_VERSION_MAJOR)-$(RT_VERSION_MINOR)-$(RT_VERSION_PATCH) + + +# This is the group that all of the installed files will be chgrp'ed to. +RTGROUP = freeside + + +# User which should own rt binaries. +BIN_OWNER = root + +# User that should own all of RT's libraries, generally root. +LIBS_OWNER = root + +# Group that should own all of RT's libraries, generally root. +LIBS_GROUP = bin + +WEB_USER = freeside +WEB_GROUP = freeside + + +APACHECTL = /usr/sbin/apachectl + + +# DESTDIR allows you to specify that RT be installed somewhere other than +# where it will eventually reside. DESTDIR _must_ have a trailing slash +# if it's defined. + +DESTDIR = + + + +RT_PATH = /opt/rt3 +RT_ETC_PATH = /opt/rt3/etc +RT_BIN_PATH = /opt/rt3/bin +RT_SBIN_PATH = /opt/rt3/sbin +RT_LIB_PATH = /opt/rt3/lib +RT_MAN_PATH = /opt/rt3/man +RT_VAR_PATH = /opt/rt3/var +RT_DOC_PATH = /opt/rt3/docs +RT_FONT_PATH = /opt/rt3/share/fonts +RT_LEXICON_PATH = /opt/rt3/share/po +RT_LOCAL_PATH = /opt/rt3/local +LOCAL_PLUGIN_PATH = /opt/rt3/local/plugins +LOCAL_ETC_PATH = /opt/rt3/local/etc +LOCAL_LIB_PATH = /opt/rt3/local/lib +LOCAL_LEXICON_PATH = /opt/rt3/local/po +MASON_HTML_PATH = /var/www/freeside/rt +MASON_LOCAL_HTML_PATH = /opt/rt3/local/html +MASON_DATA_PATH = /usr/local/etc/freeside/masondata +MASON_SESSION_PATH = /opt/rt3/var/session_data +RT_LOG_PATH = /opt/rt3/var/log + +# RT_READABLE_DIR_MODE is the mode of directories that are generally meant +# to be accessable +RT_READABLE_DIR_MODE = 0755 + + + + + +# RT's CLI +RT_CLI_BIN = rt +# RT's mail gateway +RT_MAILGATE_BIN = rt-mailgate +# RT's cron tool +RT_CRON_BIN = rt-crontool + + + +BINARIES = $(RT_MAILGATE_BIN) \ + $(RT_CLI_BIN) \ + $(RT_CRON_BIN) + +SYSTEM_BINARIES = rt-attributes-viewer \ + rt-clean-sessions \ + rt-dump-metadata \ + rt-email-dashboards \ + rt-email-digest \ + rt-email-group-admin \ + rt-fulltext-indexer \ + rt-preferences-viewer \ + rt-server \ + rt-session-viewer \ + rt-server.fcgi \ + rt-session-viewer \ + rt-setup-database \ + rt-setup-fulltext-index \ + rt-shredder \ + rt-test-dependencies \ + rt-validator \ + rt-validate-aliases \ + standalone_httpd + + +ETC_FILES = acl.Pg \ + acl.Oracle \ + acl.mysql \ + schema.Pg \ + schema.Oracle \ + schema.mysql \ + schema.SQLite \ + initialdata + + + +WEB_HANDLER = modperl2 + + + +# +# DB_TYPE defines what sort of database RT trys to talk to +# "mysql", "Oracle", "Pg", and "SQLite" are known to work. + +DB_TYPE = Pg + +# Set DBA to the name of a unix account with the proper permissions and +# environment to run your commandline SQL sbin + +# Set DB_DBA to the name of a DB user with permission to create new databases + +# For mysql, you probably want 'root' +# For Pg, you probably want 'postgres' +# For Oracle, you want 'system' + +DB_DBA = freeside + +DB_HOST = localhost + +# If you're not running your database server on its default port, +# specifiy the port the database server is running on below. +# It's generally safe to leave this blank + +DB_PORT = + + + + +# +# Set this to the canonical name of the interface RT will be talking to the +# database on. If you said that the RT_DB_HOST above was "localhost," this +# should be too. This value will be used to grant rt access to the database. +# If you want to access the RT database from multiple hosts, you'll need +# to grant those database rights by hand. +# + +DB_RT_HOST = localhost + +# set this to the name you want to give to the RT database in +# your database server. For Oracle, this should be the name of your sid + +DB_DATABASE = freeside +DB_RT_USER = freeside +DB_RT_PASS = + + + +TEST_FILES = t/*.t t/*/*.t +TEST_VERBOSE = 0 + +RT_TEST_PARALLEL_NUM ?= 5 + + +#################################################################### + +all: default + +default: + @echo "Please read RT's README before beginning your installation." + + + +instruct: + @echo "Congratulations. RT is now installed." + @echo "" + @echo "" + @echo "You must now configure RT by editing $(SITE_CONFIG_FILE)." + @echo "" + @echo "(You will definitely need to set RT's database password in " + @echo "$(SITE_CONFIG_FILE) before continuing. Not doing so could be " + @echo "very dangerous. Note that you do not have to manually add a " + @echo "database user or set up a database for RT. These actions will be " + @echo "taken care of in the next step.)" + @echo "" + @echo "After that, you need to initialize RT's database by running" + @echo " 'make initialize-database'" + + +upgrade-instruct: + @echo "Congratulations. RT has been upgraded. You should now check over" + @echo "$(CONFIG_FILE) for any necessary site customization. Additionally," + @echo "you should update RT's system database objects by running " + @echo " make upgrade-database" + + +upgrade: testdeps config-install dirs files-install fixperms upgrade-instruct + +my_with_web_handlers= $(shell $(PERL) -e 'print join " ", map "--with-$$_", grep defined && length, split /,/, "$(WEB_HANDLER)"') +testdeps: + $(PERL) ./sbin/rt-test-dependencies --verbose --with-$(DB_TYPE) $(my_with_web_handlers) + +depends: fixdeps + +fixdeps: + $(PERL) ./sbin/rt-test-dependencies --verbose --install --with-$(DB_TYPE) $(my_with_web_handlers) + +#}}} + +fixperms: + # Make the libraries readable + chmod $(RT_READABLE_DIR_MODE) $(DESTDIR)$(RT_PATH) + chown -R $(LIBS_OWNER) $(DESTDIR)$(RT_LIB_PATH) + chgrp -R $(LIBS_GROUP) $(DESTDIR)$(RT_LIB_PATH) + chmod -R u+rwX,go-w,go+rX $(DESTDIR)$(RT_LIB_PATH) + + + chmod $(RT_READABLE_DIR_MODE) $(DESTDIR)$(RT_BIN_PATH) + + chmod 0755 $(DESTDIR)$(RT_ETC_PATH) + cd $(DESTDIR)$(RT_ETC_PATH) && chmod 0400 $(ETC_FILES) || true + + #TODO: the config file should probably be able to have its + # owner set separately from the binaries. + chown -R $(BIN_OWNER) $(DESTDIR)$(RT_ETC_PATH) + chgrp -R $(RTGROUP) $(DESTDIR)$(RT_ETC_PATH) + + chmod 0440 $(DESTDIR)$(CONFIG_FILE) + chmod 0640 $(DESTDIR)$(SITE_CONFIG_FILE) + # Make this externally readable + chmod 0440 $(DESTDIR)$(RT_ETC_PATH)/initialdata + + # Make the system binaries + cd $(DESTDIR)$(RT_BIN_PATH) && ( chmod 0755 $(BINARIES) ; chown $(BIN_OWNER) $(BINARIES); chgrp $(RTGROUP) $(BINARIES)) + + # Make the system binaries executable also + cd $(DESTDIR)$(RT_SBIN_PATH) && ( chmod 0755 $(SYSTEM_BINARIES) ; chown $(BIN_OWNER) $(SYSTEM_BINARIES); chgrp $(RTGROUP) $(SYSTEM_BINARIES)) + + # Make upgrade scripts executable if they are in the source. + # + # Note that we use the deprecated (by GNU/POSIX find) -perm +0NNN syntax + # instead of -perm /0NNN since BSD find doesn't support the latter. + ( cd etc/upgrade && find . -type f -not -name '*.in' -perm +0111 -print ) | while read file ; do \ + chmod a+x "$(DESTDIR)$(RT_ETC_PATH)/upgrade/$$file" ; \ + done + + # Make the web ui readable by all. + chmod -R u+rwX,go-w,go+rX $(DESTDIR)$(MASON_HTML_PATH) \ + $(DESTDIR)$(MASON_LOCAL_HTML_PATH) \ + $(DESTDIR)$(RT_LEXICON_PATH) \ + $(DESTDIR)$(LOCAL_LEXICON_PATH) + chown -R $(LIBS_OWNER) $(DESTDIR)$(MASON_HTML_PATH) \ + $(DESTDIR)$(MASON_LOCAL_HTML_PATH) \ + $(DESTDIR)$(RT_LEXICON_PATH) \ + $(DESTDIR)$(LOCAL_LEXICON_PATH) + chgrp -R $(LIBS_GROUP) $(DESTDIR)$(MASON_HTML_PATH) \ + $(DESTDIR)$(MASON_LOCAL_HTML_PATH) \ + $(DESTDIR)$(RT_LEXICON_PATH) \ + $(DESTDIR)$(LOCAL_LEXICON_PATH) + + # Make the web ui's data dir writable + chmod 0770 $(DESTDIR)$(MASON_DATA_PATH) \ + $(DESTDIR)$(MASON_SESSION_PATH) + chown -R $(WEB_USER) $(DESTDIR)$(MASON_DATA_PATH) \ + $(DESTDIR)$(MASON_SESSION_PATH) + chgrp -R $(WEB_GROUP) $(DESTDIR)$(MASON_DATA_PATH) \ + $(DESTDIR)$(MASON_SESSION_PATH) + +dirs: + $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LOG_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_FONT_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LEXICON_PATH) + $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH) + $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)/cache + $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)/etc + $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)/obj + $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_SESSION_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(MASON_HTML_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(MASON_LOCAL_HTML_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_ETC_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_LIB_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_PLUGIN_PATH) + $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_LEXICON_PATH) + +install: testdeps config-install dirs files-install fixperms instruct + +files-install: libs-install etc-install config-install bin-install sbin-install html-install doc-install font-install po-install + +config-install: + $(INSTALL) -m 0755 -o $(BIN_OWNER) -g $(RTGROUP) -d $(DESTDIR)$(CONFIG_FILE_PATH) + -$(INSTALL) -m 0440 -o $(BIN_OWNER) -g $(RTGROUP) etc/RT_Config.pm $(DESTDIR)$(CONFIG_FILE) + [ -f $(DESTDIR)$(SITE_CONFIG_FILE) ] || $(INSTALL) -m 0640 -o $(BIN_OWNER) -g $(RTGROUP) etc/RT_SiteConfig.pm $(DESTDIR)$(SITE_CONFIG_FILE) + @echo "Installed configuration. About to install RT in $(RT_PATH)" + +test: + $(PERL) "-MExtUtils::Command::MM" -e "test_harness($(TEST_VERBOSE), 'lib')" $(TEST_FILES) + +parallel-test: test-parallel + +test-parallel: + RT_TEST_PARALLEL=1 $(PERL) "-MApp::Prove" -e 'my $$p = App::Prove->new(); $$p->process_args("-wlrj$(RT_TEST_PARALLEL_NUM)","--state=slow,save", "t"); exit( $$p->run() ? 0 : 1 )' + +regression-reset-db: force-dropdb + $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action init --dba-password '' + +initdb :: initialize-database + +initialize-database: + $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action init --prompt-for-dba-password + +upgrade-database: + $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action upgrade --prompt-for-dba-password + +dropdb: + $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action drop --prompt-for-dba-password + +force-dropdb: + $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action drop --dba-password '' --force + +critic: + perlcritic --quiet sbin bin lib + +libs-install: + [ -d $(DESTDIR)$(RT_LIB_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LIB_PATH) + -( cd lib && find . -type d -print ) | while read dir ; do \ + $(INSTALL) -m 0755 -d "$(DESTDIR)$(RT_LIB_PATH)/$$dir" ; \ + done + -( cd lib && find . -type f -print ) | while read file ; do \ + $(INSTALL) -m 0644 "lib/$$file" "$(DESTDIR)$(RT_LIB_PATH)/$$file" ; \ + done + +html-install: + [ -d $(DESTDIR)$(MASON_HTML_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(MASON_HTML_PATH) + -( cd share/html && find . -type d -print ) | while read dir ; do \ + $(INSTALL) -m 0755 -d "$(DESTDIR)$(MASON_HTML_PATH)/$$dir" ; \ + done + -( cd share/html && find . -type f -print ) | while read file ; do \ + $(INSTALL) -m 0644 "share/html/$$file" "$(DESTDIR)$(MASON_HTML_PATH)/$$file" ; \ + done + +font-install: + [ -d $(DESTDIR)$(RT_FONT_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_FONT_PATH) + -( cd share/fonts && find . -type f -print ) | while read file ; do \ + $(INSTALL) -m 0644 "share/fonts/$$file" "$(DESTDIR)$(RT_FONT_PATH)/$$file" ; \ + done + + +po-install: + [ -d $(DESTDIR)$(RT_LEXICON_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LEXICON_PATH) + -( cd share/po && find . -type f -print ) | while read file ; do \ + $(INSTALL) -m 0644 "share/po/$$file" "$(DESTDIR)$(RT_LEXICON_PATH)/$$file" ; \ + done + + + +doc-install: + # RT 3.0.0 - RT 3.0.2 would accidentally create a file instead of a dir + -[ -f $(DESTDIR)$(RT_DOC_PATH) ] && rm $(DESTDIR)$(RT_DOC_PATH) + [ -d $(DESTDIR)$(RT_DOC_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_DOC_PATH) + -( cd docs && find . -type d -print ) | while read dir ; do \ + $(INSTALL) -m 0755 -d "$(DESTDIR)$(RT_DOC_PATH)/$$dir" ; \ + done + -( cd docs && find . -type f -print ) | while read file ; do \ + $(INSTALL) -m 0644 "docs/$$file" "$(DESTDIR)$(RT_DOC_PATH)/$$file" ; \ + done + -$(INSTALL) -m 0644 ./README $(DESTDIR)$(RT_DOC_PATH)/ + + +etc-install: + [ -d $(DESTDIR)$(RT_ETC_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_ETC_PATH) + for file in $(ETC_FILES) ; do \ + $(INSTALL) -m 0644 "etc/$$file" "$(DESTDIR)$(RT_ETC_PATH)/" ; \ + done + [ -d $(DESTDIR)$(RT_ETC_PATH)/upgrade ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_ETC_PATH)/upgrade + -( cd etc/upgrade && find . -type d -print ) | while read dir ; do \ + $(INSTALL) -m 0755 -d "$(DESTDIR)$(RT_ETC_PATH)/upgrade/$$dir" ; \ + done + -( cd etc/upgrade && find . -type f -not -name '*.in' -print ) | while read file ; do \ + $(INSTALL) -m 0644 "etc/upgrade/$$file" "$(DESTDIR)$(RT_ETC_PATH)/upgrade/$$file" ; \ + done + + +sbin-install: + $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_SBIN_PATH) + for file in $(SYSTEM_BINARIES) ; do \ + $(INSTALL) -o $(BIN_OWNER) -g $(RTGROUP) -m 0755 "sbin/$$file" "$(DESTDIR)$(RT_SBIN_PATH)/" ; \ + done + + + +bin-install: + $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_BIN_PATH) + for file in $(BINARIES) ; do \ + $(INSTALL) -o $(BIN_OWNER) -g $(RTGROUP) -m 0755 "bin/$$file" "$(DESTDIR)$(RT_BIN_PATH)/" ; \ + done + + + +regenerate-catalogs: + $(PERL) devel/tools/extract-message-catalog + +license-tag: + $(PERL) devel/tools/license_tag + +factory: initialize-database + cd lib; $(PERL) ../devel/tools/factory $(DB_DATABASE) RT + +start-httpd: + $(PERL) sbin/standalone_httpd & + +start-server: + $(PERL) sbin/rt-server & + +apachectl: + $(APACHECTL) stop + sleep 10 + $(APACHECTL) start + sleep 5 + +SNAPSHOT=$(shell git describe --tags) +THIRD_PARTY=devel/third-party/ +snapshot: build-snapshot build-third-party clearsign-snapshot clearsign-third-party snapshot-shasums + +build-snapshot: + git archive --prefix "$(SNAPSHOT)/" HEAD | tar -xf - + ( cd $(SNAPSHOT) && \ + echo "$(SNAPSHOT)" > .tag && \ + autoconf && \ + INSTALL=./install-sh PERL=/usr/bin/perl ./configure \ + --with-db-type=SQLite \ + --enable-layout=relative \ + --with-web-handler=standalone && \ + rm -rf autom4te.cache \ + config.status config.log config.pld \ + ) + tar -czf "$(SNAPSHOT).tar.gz" "$(SNAPSHOT)/" + rm -fr "$(SNAPSHOT)/" + +clearsign-snapshot: + gpg --no-armor --detach-sign "$(SNAPSHOT).tar.gz" + +build-third-party: + git archive --prefix "$(SNAPSHOT)/$(THIRD_PARTY)" HEAD:$(THIRD_PARTY) \ + | gzip > "$(SNAPSHOT)-third-party-source.tar.gz" + rm -rf "$(SNAPSHOT)/$(THIRD_PARTY)" + +clearsign-third-party: + gpg --no-armor --detach-sign "$(SNAPSHOT)-third-party-source.tar.gz" + +snapshot-shasums: + sha1sum $(SNAPSHOT)*.tar.gz* + +vessel-import: build-snapshot + [ -d $(VESSEL) ] || (echo "VESSEL isn't a path to your shipwright vessel" && exit -1) + cp $(VESSEL)/scripts/RT/build.pl /tmp/build.pl + ./sbin/rt-test-dependencies --with-standalone --with-fastcgi --with-sqlite --list > /tmp/rt.yml + shipwright import file:$(SNAPSHOT).tar.gz \ + --require-yml /tmp/rt.yml \ + --build-script /tmp/build.pl \ + --name RT \ + --repository fs:$(VESSEL) \ + --log-level=info \ + --skip cpan-capitalization,cpan-mod_perl,cpan-Encode,cpan-PPI,cpan-Test-Exception-LessClever,cpan-Test-Manifest,cpan-Test-Object,cpan-Test-Pod,cpan-Test-Requires,cpan-Test-SubCalls,cpan-Test-cpan-Tester,cpan-Test-Warn --skip-all-recommends + mv $(VESSEL)/scripts/RT/build $(VESSEL)/scripts/RT/build.pl + +JSMIN_URL = http://download.bestpractical.com/mirror/jsmin-2011-01-22.c +JSMIN_SHA = 8a6b3b980a52c028eb73aee4a82ebe060c1ee854 + +jsmin: jsmin-checkcc jsmin-fetch jsmin-verify jsmin-confirm jsmin-build jsmin-install + @echo "" + @echo "To configure RT to use jsmin, add the following line to $(DESTDIR)$(RT_ETC_PATH)/RT_SiteConfig.pm:" + @echo "" + @echo " Set(\$$JSMinPath, '$(DESTDIR)$(RT_BIN_PATH)/jsmin');" + @echo "" + +jsmin-checkcc: + @[ -n "$(CC)" ] || (echo "You don't appear to have a C compiler, please set CC and re-run configure" && exit 1) + +jsmin-confirm: + @echo "jsmin is distributed under a slightly unusual license and can't be shipped" + @echo "with RT. Before configuring RT to use jsmin, please read jsmin's license" + @echo "below:" + @echo "" + @$(PERL) -pe 'print && exit if /^\*\// or /^#include/' jsmin.c + @echo "" + @echo "Press Enter to accept the license, or Ctrl-C to stop now." + @$(PERL) -e '<STDIN>' + +jsmin-fetch: + @echo "" + @echo "Downloading jsmin.c from $(JSMIN_URL)" + @echo "" + @$(PERL) -MLWP::Simple -e 'exit not is_success(getstore("$(JSMIN_URL)", "jsmin.c"))' \ + || (echo "Failed to download $(JSMIN_URL)" && exit 1) + +jsmin-verify: + @$(PERL) -MDigest::SHA -e \ + 'exit not Digest::SHA->new(1)->addfile("jsmin.c")->hexdigest eq "$(JSMIN_SHA)"' \ + || (echo "Verification of jsmin.c failed! Possible man in the middle?" && exit 1) + +jsmin-build: + $(CC) -o jsmin jsmin.c + +jsmin-install: + $(INSTALL) -o $(BIN_OWNER) -g $(RTGROUP) -m 0755 "jsmin" "$(DESTDIR)$(RT_BIN_PATH)/" @@ -322,6 +322,7 @@ sub list { } if ( ! $rawprint and ! exists $data{format} ) { $data{format} = 'l'; + $data{fields} = 'subject,status,queue,created,told,owner,requestors'; } if ( $reverse_sort and $data{orderby} =~ /^-/ ) { $data{orderby} =~ s/^-/+/; diff --git a/rt/bin/rt-crontool b/rt/bin/rt-crontool new file mode 100755 index 000000000..be189b5ce --- /dev/null +++ b/rt/bin/rt-crontool @@ -0,0 +1,468 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 Carp; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use RT; + +use Getopt::Long; + +use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc); + +#Clean out all the nasties from the environment +CleanEnv(); + +my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg, + $template, $template_id, $transaction, $transaction_type, $help, $log, $verbose ); +GetOptions( + "search=s" => \$search, + "search-arg=s" => \$search_arg, + "condition=s" => \$condition, + "condition-arg=s" => \$condition_arg, + "action-arg=s" => \$action_arg, + "action=s" => \$action, + "template=s" => \$template, + "template-id=s" => \$template_id, + "transaction=s" => \$transaction, + "transaction-type=s" => \$transaction_type, + "log=s" => \$log, + "verbose|v" => \$verbose, + "help" => \$help, +); + +# Load the config file +RT::LoadConfig(); + +# adjust logging to the screen according to options +RT->Config->Set( LogToScreen => $log ) if $log; + +#Connect to the database and get RT::SystemUser and RT::Nobody loaded +RT::Init(); + +require RT::Tickets; +require RT::Template; + +#Get the current user all loaded +my $CurrentUser = GetCurrentUser(); + +# show help even if there is no current user +help() if $help; + +unless ( $CurrentUser->Id ) { + print loc("No RT user found. Please consult your RT administrator."); + exit(1); +} + +help() unless $search && $action; + +$transaction = lc( $transaction||'' ); +if ( $transaction && $transaction !~ /^(first|all|last)$/i ) { + print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'"); + exit 1; +} + +if ( $template && $template_id ) { + print STDERR loc("--template-id is deprecated argument and can not be used with --template"); + exit 1; +} +elsif ( $template_id ) { +# don't warn + $template = $template_id; +} + +# We _must_ have a search object +load_module($search); +load_module($action) if ($action); +load_module($condition) if ($condition); + +my $void_scrip = RT::Scrip->new( $CurrentUser ); +my $void_scrip_action = RT::ScripAction->new( $CurrentUser ); + +#At the appointed time: + +#find a bunch of tickets +my $tickets = RT::Tickets->new($CurrentUser); +$search = $search->new( + TicketsObj => $tickets, + Argument => $search_arg, + CurrentUser => $CurrentUser +); +$search->Prepare(); + +#for each ticket we've found +while ( my $ticket = $tickets->Next() ) { + print $ticket->Id() . ":\n" if ($verbose); + + my $template_obj = get_template( $ticket ); + + if ( $transaction ) { + my $txns = get_transactions($ticket); + my $found = 0; + while ( my $txn = $txns->Next ) { + print "\t".loc("Using transaction #[_1]...", $txn->id)."\n" + if $verbose; + process($ticket, $txn, $template_obj); + $found = 1; + } + print "\t".loc("Couldn't find suitable transaction, skipping")."\n" + if $verbose && !$found; + } else { + print "\t".loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")."\n" + if $verbose; + + process($ticket, undef, $template_obj); + } +} + +sub process { + my $ticket = shift; + my $transaction = shift; + my $template_obj = shift; + + # perform some more advanced check + if ($condition) { + my $condition_obj = $condition->new( + TransactionObj => $transaction, + TicketObj => $ticket, + ScripObj => $void_scrip, + TemplateObj => $template_obj, + Argument => $condition_arg, + CurrentUser => $CurrentUser, + ); + + # if the condition doesn't apply, get out of here + + return unless $condition_obj->IsApplicable; + print "\t".loc("Condition matches...")."\n" if $verbose; + } + + #prepare our action + my $action_obj = $action->new( + TicketObj => $ticket, + TransactionObj => $transaction, + TemplateObj => $template_obj, + Argument => $action_arg, + ScripObj => $void_scrip, + ScripActionObj => $void_scrip_action, + CurrentUser => $CurrentUser, + ); + + #if our preparation, move onto the next ticket + return unless $action_obj->Prepare; + print "\t".loc("Action prepared...")."\n" if $verbose; + + #commit our action. + return unless $action_obj->Commit; + print "\t".loc("Action committed.")."\n" if $verbose; +} + +# =head2 get_transactions +# +# Takes ticket and returns L<RT::Transactions> object with transactions +# of the ticket according to command line arguments C<--transaction> +# and <--transaction-type>. +# +# =cut + +sub get_transactions { + my $ticket = shift; + my $txns = $ticket->Transactions; + my $order = $transaction eq 'last'? 'DESC': 'ASC'; + $txns->OrderByCols( + { FIELD => 'Created', ORDER => $order }, + { FIELD => 'id', ORDER => $order }, + ); + if ( $transaction_type ) { + $transaction_type =~ s/^\s+//; + $transaction_type =~ s/\s+$//; + foreach my $type ( split /\s*,\s*/, $transaction_type ) { + $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' ); + } + } + $txns->RowsPerPage(1) unless $transaction eq 'all'; + return $txns; +} + +# =head2 get_template +# +# Takes a ticket and returns a template according to command line options. +# +# =cut + +{ my $cache = undef; +sub get_template { + my $ticket = shift; + return undef unless $template; + + unless ( $template =~ /\D/ ) { + # by id + return $cache if $cache; + + my $cache = RT::Template->new( RT->SystemUser ); + $cache->Load( $template ); + die "Failed to load template '$template'" + unless $cache->id; + return $cache; + } + + my $queue = $ticket->Queue; + return $cache->{ $queue } if $cache->{ $queue }; + + my $res = RT::Template->new( RT->SystemUser ); + $res->LoadQueueTemplate( Queue => $queue, Name => $template ); + unless ( $res->id ) { + $res->LoadGlobalTemplate( $template ); + die "Failed to load template '$template', either for queue #$queue or global" + unless $res->id; + } + return $cache->{ $queue } = $res; +} } + + +# =head2 load_module +# +# Loads a perl module, dying nicely if it can't find it. +# +# =cut + +sub load_module { + my $modname = shift; + eval "require $modname"; + if ($@) { + die loc( "Failed to load module [_1]. ([_2])", $modname, $@ ); + } + +} + + +sub help { + + print loc( "[_1] is a tool to act on tickets from an external scheduling tool, such as cron.", $0 ) + . "\n"; + print loc("It takes several arguments:") . "\n\n"; + + print " " + . loc( "[_1] - Specify the search module you want to use", "--search" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--search-arg", "--search" ) + . "\n"; + + print " " + . loc( "[_1] - Specify the condition module you want to use", "--condition" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--condition-arg", "--condition" ) + . "\n"; + print " " + . loc( "[_1] - Specify the action module you want to use", "--action" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--action-arg", "--action" ) + . "\n"; + print " " + . loc( "[_1] - Specify name or id of template(s) you want to use", "--template" ) + . "\n"; + print " " + . loc( "[_1] - Specify if you want to use either 'first', 'last' or 'all' transactions", "--transaction" ) + . "\n"; + print " " + . loc( "[_1] - Specify the comma separated list of transactions' types you want to use", "--transaction-type" ) + . "\n"; + print " " + . loc( "[_1] - Adjust LogToScreen config option", "--log" ) . "\n"; + print " " + . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n"; + print "\n"; + print "\n"; + print loc("Security:")."\n"; + print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ". + loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ". + loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " . + loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n"; + print "\n"; + print loc("Example:"); + print "\n"; + print " " + . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they are overdue:" + ) + . "\n\n"; + + print " bin/rt-crontool \\\n"; + print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; + print " --condition RT::Condition::Overdue \\\n"; + print " --action RT::Action::SetPriority --action-arg 99 \\\n"; + print " --verbose\n"; + + print "\n"; + print loc("Escalate tickets"). "\n"; + print " bin/rt-crontool \\\n"; + print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; + print" --action RT::Action::EscalatePriority\n"; + + + + + + + exit(0); +} + +__END__ + +=head1 NAME + +rt-crontool - a tool to act on tickets from an external scheduling tool + +=head1 SYNOPSIS + + # find all active tickets in the queue 'general' and set their priority to 99 if they are overdue: + rt-crontool \ + --search RT::Search::ActiveTicketsInQueue --search-arg general \ + --condition RT::Condition::Overdue \ + --action RT::Action::SetPriority --action-arg 99 \ + --verbose + + # Escalate tickets + rt-crontool \ + --search RT::Search::ActiveTicketsInQueue --search-arg general \ + --action RT::Action::EscalatePriority + +=head1 DESCRIPTION + +This script is a tool to act on tickets from an external scheduling tool, such +as cron. + +Security: + +This tool allows the user to run arbitrary perl modules from within RT. If +this tool were setgid, a hostile local user could use this tool to gain +administrative access to RT. It is incredibly important that nonprivileged +users not be allowed to run this tool. It is suggested that you create a +non-privileged unix user with the correct group membership and RT access to +run this tool. + + +=head1 OPTIONS + +=over + +=item search + +Specify the search module you want to use + +=item search-arg + +An argument to pass to --search + +=item condition + +Specify the condition module you want to use + +=item condition-arg + +An argument to pass to --condition + +=item action + +Specify the action module you want to use + +=item action-arg + +An argument to pass to --action + +=item template + +Specify name or id of template(s) you want to use + +=item transaction + +Specify if you want to use either 'first', 'last' or 'all' transactions + + +=item transaction-type + +Specify the comma separated list of transactions' types you want to use + +=item log + +Adjust LogToScreen config option + +=item verbose + +Output status updates to STDOUT + +=back + diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate new file mode 100755 index 000000000..5148aa541 --- /dev/null +++ b/rt/bin/rt-mailgate @@ -0,0 +1,526 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} +=head1 NAME + +rt-mailgate - Mail interface to RT. + +=cut + +use strict; +use warnings; + +use Getopt::Long; + +my $opts = { }; +GetOptions( $opts, "queue=s", "action=s", "url=s", + "jar=s", "help", "debug", "extension=s", + "timeout=i", "verify-ssl!", "ca-file=s", + ); + +my $gateway = RT::Client::MailGateway->new(); + +$gateway->run($opts); + +package RT::Client::MailGateway; + +use LWP::UserAgent; +use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD); +use File::Temp qw(tempfile tempdir); +$DYNAMIC_FILE_UPLOAD = 1; + +use constant EX_TEMPFAIL => 75; +use constant BUFFER_SIZE => 8192; + +sub new { + my $class = shift; + my $self = bless {}, $class; + return $self; +} + +sub run { + my $self = shift; + my $opts = shift; + + if ( $opts->{running_in_test_harness} ) { + $self->{running_in_test_harness} = 1; + } + + $self->validate_cli_flags($opts); + + my $ua = $self->get_useragent($opts); + my $post_params = $self->setup_session($opts); + $self->upload_message( $ua => $post_params ); + $self->exit_with_success(); +} + +sub exit_with_success { + my $self = shift; + if ( $self->{running_in_test_harness} ) { + return 1; + } else { + exit 0; + } +} + +sub tempfail { + my $self = shift; + if ( $self->{running_in_test_harness} ) { + die "tempfail"; + } else { + + exit EX_TEMPFAIL; + } +} + +sub permfail { + my $self = shift; + if ( $self->{running_in_test_harness} ) { + die "permfail"; + } else { + + exit 1; + } +} + +sub validate_cli_flags { + my $self = shift; + my $opts = shift; + if ( $opts->{'help'} ) { + require Pod::Usage; + Pod::Usage::pod2usage( { verbose => 2 } ); + return $self->permfail() + ; # Don't want to succeed if this is really an email! + } + + unless ( $opts->{'url'} ) { + print STDERR + "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n"; + return $self->permfail(); + } + + if (($opts->{'ca-file'} or $opts->{"verify-ssl"}) + and not LWP::UserAgent->can("ssl_opts")) { + print STDERR "Verifying SSL certificates requires LWP::UserAgent 6.0 or higher.\n"; + return $self->tempfail(); + } + + $opts->{"verify-ssl"} = 1 unless defined $opts->{"verify-ssl"}; +} + +sub get_useragent { + my $self = shift; + my $opts = shift; + my $ua = LWP::UserAgent->new(); + $ua->cookie_jar( { file => $opts->{'jar'} } ) if $opts->{'jar'}; + + if ( $ua->can("ssl_opts") ) { + $ua->ssl_opts( verify_hostname => $opts->{'verify-ssl'} ); + $ua->ssl_opts( SSL_ca_file => $opts->{'ca-file'} ) + if $opts->{'ca-file'}; + } + + return $ua; +} + +sub setup_session { + my $self = shift; + my $opts = shift; + my %post_params; + foreach (qw(queue action)) { + $post_params{$_} = $opts->{$_} if defined $opts->{$_}; + } + + if ( ( $opts->{'extension'} || '' ) =~ /^(?:action|queue|ticket)$/i ) { + $post_params{ lc $opts->{'extension'} } = $ENV{'EXTENSION'} + || $opts->{ $opts->{'extension'} }; + } elsif ( $opts->{'extension'} && $ENV{'EXTENSION'} ) { + print STDERR + "Value of the --extension argument is not action, queue or ticket" + . ", but environment variable EXTENSION is also defined. The former is ignored.\n"; + } + + # add ENV{'EXTENSION'} as X-RT-MailExtension to the message header + if ( my $value = ( $ENV{'EXTENSION'} || $opts->{'extension'} ) ) { + + # prepare value to avoid MIME format breakage + # strip trailing newline symbols + $value =~ s/(\r*\n)+$//; + + # make a correct multiline header field, + # with tabs in the beginning of each line + $value =~ s/(\r*\n)/$1\t/g; + $opts->{'headers'} .= "X-RT-Mail-Extension: $value\n"; + } + + # Read the message in from STDIN + # _raw_message is used for testing + my $message = $opts->{'_raw_message'} || $self->slurp_message(); + unless ( $message->{'filename'} ) { + $post_params{'message'} = [ + undef, '', + 'Content-Type' => 'application/octet-stream', + Content => ${ $message->{'content'} }, + ]; + } else { + $post_params{'message'} = [ + $message->{'filename'}, '', + 'Content-Type' => 'application/octet-stream', + ]; + } + + return \%post_params; +} + +sub upload_message { + my $self = shift; + my $ua = shift; + my $post_params = shift; + my $full_url = $opts->{'url'} . "/REST/1.0/NoAuth/mail-gateway"; + print STDERR "$0: connecting to $full_url\n" if $opts->{'debug'}; + + $ua->timeout( exists( $opts->{'timeout'} ) ? $opts->{'timeout'} : 180 ); + my $r = $ua->post( $full_url, $post_params, Content_Type => 'form-data' ); + $self->check_failure($r); + + my $content = $r->content; + print STDERR $content . "\n" if $opts->{'debug'}; + + return if ( $content =~ /^(ok|not ok)/ ); + + # It's not the server's fault if the mail is bogus. We just want to know that + # *something* came out of the server. + print STDERR <<EOF; +RT server error. + +The RT server which handled your email did not behave as expected. It +said: + +$content +EOF + + return $self->tempfail(); +} + +sub check_failure { + my $self = shift; + my $r = shift; + return if $r->is_success; + + # XXX TODO 4.2: Remove the multi-line error strings in favor of something more concise + print STDERR <<" ERROR"; +An Error Occurred +================= + +@{[ $r->status_line ]} + ERROR + print STDERR "\n$0: undefined server error\n" if $opts->{'debug'}; + return $self->tempfail(); +} + +sub slurp_message { + my $self = shift; + + local $@; + + my %message; + my ( $fh, $filename ) + = eval { tempfile( DIR => tempdir( CLEANUP => 1 ) ) }; + if ( !$fh || $@ ) { + print STDERR "$0: Couldn't create temp file, using memory\n"; + print STDERR "error: $@\n" if $@; + + my $message = \do { local ( @ARGV, $/ ); <STDIN> }; + unless ( $$message =~ /\S/ ) { + print STDERR "$0: no message passed on STDIN\n"; + $self->exit_with_success; + } + $$message = $opts->{'headers'} . $$message if $opts->{'headers'}; + return ( { content => $message } ); + } + + binmode $fh; + binmode \*STDIN; + + print $fh $opts->{'headers'} if $opts->{'headers'}; + + my $buf; + my $empty = 1; + while (1) { + my $status = read \*STDIN, $buf, BUFFER_SIZE; + unless ( defined $status ) { + print STDERR "$0: couldn't read message: $!\n"; + return $self->tempfail(); + } elsif ( !$status ) { + last; + } + $empty = 0 if $buf =~ /\S/; + print $fh $buf; + } + close $fh; + + if ($empty) { + print STDERR "$0: no message passed on STDIN\n"; + $self->exit_with_success; + } + print STDERR "$0: temp file is '$filename'\n" if $opts->{'debug'}; + return ( { filename => $filename } ); +} + +=head1 SYNOPSIS + + rt-mailgate --help : this text + +Usual invocation (from MTA): + + rt-mailgate --action (correspond|comment|...) --queue queuename + --url http://your.rt.server/ + [ --debug ] + [ --extension (queue|action|ticket) ] + [ --timeout seconds ] + + + +=head1 OPTIONS + +=over 3 + +=item C<--action> + +Specifies what happens to email sent to this alias. The avaliable +basic actions are: C<correspond>, C<comment>. + + +If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>, +C<take> and C<resolve> are also available. You can execute two or more +actions on a single message using a C<-> separated list. RT will execute +the actions in the listed order. For example you can use C<take-comment>, +C<correspond-resolve> or C<take-comment-resolve> as actions. + +Note that C<take> and C<resolve> actions ignore message text if used +alone. Include a C<comment> or C<correspond> action if you want RT +to record the incoming message. + +The default action is C<correspond>. + +=item C<--queue> + +This flag determines which queue this alias should create a ticket in if no ticket identifier +is found. + +=item C<--url> + +This flag tells the mail gateway where it can find your RT server. You should +probably use the same URL that users use to log into RT. + +If your RT server uses SSL, you will need to install additional Perl +libraries. RT will detect and install these dependencies if you pass the +C<--enable-ssl-mailgate> flag to configure as documented in RT's README. + +If you have a self-signed SSL certificate, you may also need to pass +C<--ca-file> or C<--no-verify-ssl>, below. + +=item C<--ca-file> I<path> + +Specifies the path to the public SSL certificate for the certificate +authority that should be used to verify the website's SSL certificate. +If your webserver uses a self-signed certificate, you should +preferentially use this option over C<--no-verify-ssl>, as it will +ensure that the self-signed certificate that the mailgate is seeing the +I<right> self-signed certificate. + +=item C<--no-verify-ssl> + +This flag tells the mail gateway to trust all SSL certificates, +regardless of if their hostname matches the certificate, and regardless +of CA. This is required if you have a self-signed certificate, or some +other certificate which is not traceable back to an certificate your +system ultimitely trusts. + +Verifying SSL certificates requires L<LWP::UserAgent> version 6.0 or +higher; explicitly passing C<--verify-ssl> on prior versions will error. + +=item C<--extension> OPTIONAL + +Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host +and present "foo" in the environment variable $EXTENSION. By specifying +the value "queue" for this parameter, the queue this message should be +submitted to will be set to the value of $EXTENSION. By specifying +"ticket", $EXTENSION will be interpreted as the id of the ticket this message +is related to. "action" will allow the user to specify either "comment" or +"correspond" in the address extension. + +=item C<--debug> OPTIONAL + +Print debugging output to standard error + + +=item C<--timeout> OPTIONAL + +Configure the timeout for posting the message to the web server. The +default timeout is 3 minutes (180 seconds). + +=back + + +=head1 DESCRIPTION + +The RT mail gateway is the primary mechanism for communicating with RT +via email. This program simply directs the email to the RT web server, +which handles filing correspondence and sending out any required mail. +It is designed to be run as part of the mail delivery process, either +called directly by the MTA or C<procmail>, or in a F<.forward> or +equivalent. + +=head1 SETUP + +Much of the set up of the mail gateway depends on your MTA and mail +routing configuration. However, you will need first of all to create an +RT user for the mail gateway and assign it a password; this helps to +ensure that mail coming into the web server did originate from the +gateway. + +Next, you need to route mail to C<rt-mailgate> for the queues you're +monitoring. For instance, if you're using F</etc/aliases> and you have a +"bugs" queue, you will want something like this: + + bugs: "|/opt/rt4/bin/rt-mailgate --queue bugs --action correspond + --url http://rt.mycorp.com/" + + bugs-comment: "|/opt/rt4/bin/rt-mailgate --queue bugs --action comment + --url http://rt.mycorp.com/" + +Note that you don't have to run your RT server on your mail server, as +the mail gateway will happily relay to a different machine. + +=head1 CUSTOMIZATION + +By default, the mail gateway will accept mail from anyone. However, +there are situations in which you will want to authenticate users +before allowing them to communicate with the system. You can do this +via a plug-in mechanism in the RT configuration. + +You can set the array C<@MailPlugins> to be a list of plugins. The +default plugin, if this is not given, is C<Auth::MailFrom> - that is, +authentication of the person is done based on the C<From> header of the +email. If you have additional filters or authentication mechanisms, you +can list them here and they will be called in order: + + Set( @MailPlugins => + "Filter::SpamAssassin", + "Auth::LDAP", + # ... + ); + +See the documentation for any additional plugins you have. + +You may also put Perl subroutines into the C<@MailPlugins> array, if +they behave as described below. + +=head1 WRITING PLUGINS + +What's actually going on in the above is that C<@MailPlugins> is a +list of Perl modules; RT prepends C<RT::Interface::Email::> to the name, +to form a package name, and then C<use>'s this module. The module is +expected to provide a C<GetCurrentUser> subroutine, which takes a hash of +several parameters: + +=over 4 + +=item Message + +A C<MIME::Entity> object representing the email + +=item CurrentUser + +An C<RT::CurrentUser> object + +=item AuthStat + +The authentication level returned from the previous plugin. + +=item Ticket [OPTIONAL] + +The ticket under discussion + +=item Queue [OPTIONAL] + +If we don't already have a ticket id, we need to know which queue we're talking about + +=item Action + +The action being performed. At the moment, it's one of "comment" or "correspond" + +=back + +It returns two values, the new C<RT::CurrentUser> object, and the new +authentication level. The authentication level can be zero, not allowed +to communicate with RT at all, (a "permission denied" error is mailed to +the correspondent) or one, which is the normal mode of operation. +Additionally, if C<-1> is returned, then the processing of the plug-ins +stops immediately and the message is ignored. + +=head1 ENVIRONMENT + +=over 4 + +=item EXTENSION + +Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host +and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value +of this variable to message in the C<X-RT-Mail-Extension> field of the message +header. + +See also C<--extension> option. Note that value of the environment variable is +always added to the message header when it's not empty even if C<--extension> +option is not provided. + +=back + +=cut + diff --git a/rt/bin/rt.in b/rt/bin/rt.in index 480f178b4..83c38acf6 100644 --- a/rt/bin/rt.in +++ b/rt/bin/rt.in @@ -322,6 +322,7 @@ sub list { } if ( ! $rawprint and ! exists $data{format} ) { $data{format} = 'l'; + $data{fields} = 'subject,status,queue,created,told,owner,requestors'; } if ( $reverse_sort and $data{orderby} =~ /^-/ ) { $data{orderby} =~ s/^-/+/; diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl new file mode 100644 index 000000000..8ce68ca14 --- /dev/null +++ b/rt/bin/webmux.pl @@ -0,0 +1,205 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; +local $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need +local $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; +local $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; +local $ENV{'ENV'} = '' if defined $ENV{'ENV'}; +local $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + +package HTML::Mason::Commands; +our %session; + +package RT::Mason; + +our ($Nobody, $SystemUser, $Handler, $r); + +my $protect_fd; + +sub handler { + ($r) = @_; + + if ( !$protect_fd && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'} + && $ENV{'MOD_PERL_API_VERSION'} >= 2 && fileno(STDOUT) != 1 + ) { + # under mod_perl2, STDOUT gets closed and re-opened, however new STDOUT + # is not on FD #1. In this case next IO operation will occupy this FD + # and make all system() and open "|-" dangerouse, for example DBI + # can get this FD for DB connection and system() call will close + # by putting grabage into the socket + open( $protect_fd, '>', '/dev/null' ) + or die "Couldn't open /dev/null: $!"; + unless ( fileno($protect_fd) == 1 ) { + warn "We opened /dev/null to protect FD #1, but descriptor #1 is already occupied"; + } + } + + local $SIG{__WARN__}; + local $SIG{__DIE__}; + RT::InitSignalHandlers(); + + if ($r->content_type =~ m/^httpd\b.*\bdirectory/i) { + use File::Spec::Unix; + # Our DirectoryIndex is always index.html, regardless of httpd settings + $r->filename( File::Spec::Unix->catfile( $r->filename, 'index.html' ) ); + } + + Module::Refresh->refresh if RT->Config->Get('DevelMode'); + + RT::ConnectToDatabase(); + + # none of the methods in $r gives us the information we want (most + # canonicalize /foo/../bar to /bar which is exactly what we want to avoid) + my (undef, $requested) = split ' ', $r->the_request, 3; + my $uri = URI->new("http://".$r->hostname.$requested); + my $path = URI::Escape::uri_unescape($uri->path); + + ## Each environment has its own way of handling .. and so on in paths, + ## so RT consistently forbids such paths. + if ( $path =~ m{/\.} ) { + $RT::Logger->crit("Invalid request for ".$path." aborting"); + RT::Interface::Web::Handler->CleanupRequest(); + return 400; + } + + my (%session, $status); + { + local $@; + $status = eval { $Handler->handle_request($r) }; + $RT::Logger->crit( $@ ) if $@; + } + undef %session; + + RT::Interface::Web::Handler->CleanupRequest(); + + return $status; +} + +package main; + +# check mod_perl version if it's mod_perl +BEGIN { + die "RT does not support mod_perl 1.99. Please upgrade to mod_perl 2.0" + if $ENV{'MOD_PERL'} + and $ENV{'MOD_PERL'} =~ m{mod_perl/(?:1\.9)}; +} + +require CGI; +CGI->import(qw(-private_tempfiles)); + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +require RT; +die "Wrong version of RT $RT::Version found; need 3.8.*" + unless $RT::VERSION =~ /^3\.8\./; +RT::LoadConfig(); +if ( RT->Config->Get('DevelMode') ) { + require Module::Refresh; +} +RT::Init(); + +# check compatibility of the DB +{ + my $dbh = $RT::Handle->dbh; + if ( $dbh ) { + my ($status, $msg) = $RT::Handle->CheckCompatibility( $dbh, 'post' ); + die $msg unless $status; + } +} + +require RT::Interface::Web::Handler; +$RT::Mason::Handler = RT::Interface::Web::Handler->new( + RT->Config->Get('MasonParameters') +); + +# load more for mod_perl before forking +RT::InitClasses( Heavy => 1 ) if $ENV{'MOD_PERL'} || $ENV{RT_WEBMUX_HEAVY_LOAD}; + +# we must disconnect DB before fork +$RT::Handle->dbh(undef); +undef $RT::Handle; + +if ( $ENV{'MOD_PERL'} && !RT->Config->Get('DevelMode')) { + # Under static_source, we need to purge the component cache + # each time we restart, so newer components may be reloaded. + # + # We can't do this in FastCGI or we'll blow away the component + # root _every_ time a new server starts which happens every few + # hits. + + require File::Path; + require File::Glob; + my @files = File::Glob::bsd_glob("$RT::MasonDataDir/obj/*"); + File::Path::rmtree([ @files ], 0, 1) if @files; +} + +1; diff --git a/rt/config.layout b/rt/config.layout new file mode 100644 index 000000000..044dfcff8 --- /dev/null +++ b/rt/config.layout @@ -0,0 +1,255 @@ +## +## config.layout -- Pre-defined Installation Path Layouts +## +## Hints: +## - layouts can be loaded with configure's --enable-layout=ID option +## - when no --enable-layout option is given, the default layout is `RT' +## - a trailing plus character (`+') on paths is replaced with a +## `/<target>' suffix where <target> is currently hardcoded to 'rt3'. +## (This may become a configurable parameter at some point.) +## +## The following variables must _all_ be set: +## prefix exec_prefix bindir sbindir sysconfdir mandir libdir +## datadir htmldir localstatedir logfiledir masonstatedir fontdir +## sessionstatedir customdir customhtmldir customlexdir +## (This can be seen in m4/rt_layout.m4.) +## + +# Default RT3 path layout. +<Layout RT3> + prefix: /opt/rt4 + exec_prefix: ${prefix} + bindir: ${exec_prefix}/bin + sbindir: ${exec_prefix}/sbin + sysconfdir: ${prefix}/etc + mandir: ${prefix}/man + plugindir: ${prefix}/plugins + libdir: ${prefix}/lib + datadir: ${prefix}/share + htmldir: ${datadir}/html + fontdir: ${datadir}/fonts + lexdir: ${datadir}/po + manualdir: ${prefix}/docs + localstatedir: ${prefix}/var + logfiledir: ${localstatedir}/log + masonstatedir: ${localstatedir}/mason_data + sessionstatedir: ${localstatedir}/session_data + customdir: ${prefix}/local + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> +<Layout inplace> + prefix: . + exec_prefix: ${prefix} + bindir: ${exec_prefix}/bin + sbindir: ${exec_prefix}/sbin + sysconfdir: ${prefix}/etc + mandir: ${prefix}/man + plugindir: ${prefix}/plugins + libdir: ${prefix}/lib + datadir: ${prefix}/share + htmldir: ${datadir}/html + lexdir: ${datadir}/po + fontdir: ${datadir}/fonts + manualdir: ${prefix}/docs + localstatedir: ${prefix}/var + logfiledir: ${localstatedir}/log + masonstatedir: ${localstatedir}/mason_data + sessionstatedir: ${localstatedir}/session_data + customdir: ${prefix}/local + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> + +<Layout FHS> + prefix: /usr/local + exec_prefix: ${prefix} + bindir: ${prefix}/bin + sbindir: ${prefix}/sbin + sysconfdir: /etc+ + datadir: ${prefix}/share +# FIXME: missing support for lib64 + libdir: ${prefix}/lib + mandir: ${datadir}/man +# FIXME: no such directory in FHS; shouldn't go to somewhere in "${datadir}/rt/"? + plugindir: ${datadir}/plugins + htmldir: ${datadir}/html + lexdir: ${datadir}/po + fontdir: ${datadir}/fonts + manualdir: ${datadir}/doc + localstatedir: /var + logfiledir: ${localstatedir}/log +# XXX: "/var/cache/mason/*"? + masonstatedir: ${localstatedir}/cache/mason_data + sessionstatedir: ${localstatedir}/cache/session_data + customdir: ${prefix}/local + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> + +<Layout FreeBSD> + prefix: /usr/local + exec_prefix: ${prefix} + bindir: ${exec_prefix}/bin + sbindir: ${exec_prefix}/sbin + sysconfdir: ${prefix}/etc+ + mandir: ${prefix}/man + plugindir: ${prefix}/plugins + libdir: ${prefix}/lib+ + datadir: ${prefix}/share+ + htmldir: ${datadir}/html + lexdir: ${datadir}/po + fontdir: ${datadir}/fonts + manualdir: ${prefix}/share/doc+ + logfiledir: /var/log + localstatedir: /var/run+ + masonstatedir: ${localstatedir}/mason_data + sessionstatedir: ${localstatedir}/session_data + customdir: ${prefix}/share+ + custometcdir: ${customdir}/local/etc + customhtmldir: ${customdir}/local/html + customlexdir: ${customdir}/local/po + customlibdir: ${customdir}/local/lib + customplugindir: ${customdir}/local/plugins +</Layout> + +<Layout Win32> + prefix: C:/Program Files/Request Tracker + exec_prefix: ${prefix} + bindir: ${exec_prefix}/bin + sbindir: ${exec_prefix}/sbin + sysconfdir: ${prefix}/etc + mandir: ${prefix}/man + plugindir: ${prefix}/plugins + libdir: ${prefix}/lib + datadir: ${prefix} + htmldir: ${datadir}/html + fontdir: ${datadir}/fonts + lexdir: ${datadir}/po + manualdir: ${datadir}/doc + localstatedir: ${prefix}/var + logfiledir: ${localstatedir}/log + masonstatedir: ${localstatedir}/mason_data + sessionstatedir: ${localstatedir}/session_data + customdir: ${prefix}/local + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> + +# RH path layout. +<Layout RH> + prefix: /usr + exec_prefix: ${prefix} + bindir: ${exec_prefix}/bin + sbindir: ${exec_prefix}/sbin + sysconfdir: /etc/rt3 + mandir: ${prefix}/man + libdir: ${prefix}/lib/rt3 + datadir: /var/rt3 + htmldir: ${datadir}/html + fontdir: ${datadir}/fonts + lexdir: ${datadir}/po + manualdir: ${datadir}/doc + plugindir: ${datadir}/plugins + localstatedir: /var + logfiledir: ${localstatedir}/log/rt3 + masonstatedir: ${localstatedir}/rt3/mason_data + sessionstatedir: ${localstatedir}/rt3/session_data + customdir: ${prefix}/local/rt3 + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> + + +<Layout relative> + prefix: /opt/rt4 + exec_prefix: ${prefix} + bindir: bin + sbindir: sbin + sysconfdir: etc + mandir: man + plugindir: plugins + libdir: lib + datadir: share + htmldir: ${datadir}/html + fontdir: ${datadir}/fonts + lexdir: ${datadir}/po + manualdir: docs + localstatedir: var + logfiledir: ${localstatedir}/log + masonstatedir: ${localstatedir}/mason_data + sessionstatedir: ${localstatedir}/session_data + customdir: local + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> +<Layout vessel> + prefix: /opt/rt4 + exec_prefix: ${prefix} + bindir: bin + sbindir: sbin + sysconfdir: etc/rt/ + mandir: man + libdir: lib/rt + datadir: share/rt + plugindir: ${datadir}/plugins + htmldir: ${datadir}/html + fontdir: ${datadir}/fonts + lexdir: ${datadir}/po + manualdir: docs/rt + localstatedir: var/rt/ + logfiledir: ${localstatedir}/log + masonstatedir: ${localstatedir}/mason_data + sessionstatedir: ${localstatedir}/session_data + customdir: local/rt/ + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> + +<Layout Freeside> + prefix: /opt/rt3 + exec_prefix: ${prefix} + bindir: ${exec_prefix}/bin + sbindir: ${exec_prefix}/sbin + sysconfdir: ${prefix}/etc + mandir: ${prefix}/man + plugindir: ${prefix}/plugins + libdir: ${prefix}/lib + datadir: ${prefix}/share + htmldir: /var/www/freeside/rt + fontdir: ${datadir}/fonts + lexdir: ${datadir}/po + manualdir: ${prefix}/docs + localstatedir: ${prefix}/var + logfiledir: ${localstatedir}/log + masonstatedir: /usr/local/etc/freeside/masondata + sessionstatedir: ${localstatedir}/session_data + customdir: ${prefix}/local + custometcdir: ${customdir}/etc + customhtmldir: ${customdir}/html + customlexdir: ${customdir}/po + customlibdir: ${customdir}/lib + customplugindir: ${customdir}/plugins +</Layout> + diff --git a/rt/config.log b/rt/config.log new file mode 100644 index 000000000..1ae6b429a --- /dev/null +++ b/rt/config.log @@ -0,0 +1,299 @@ +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by RT configure rt-4.0.21, which was +generated by GNU Autoconf 2.68. Invocation command line was + + $ ./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pass= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2 + +## --------- ## +## Platform. ## +## --------- ## + +hostname = fleetpaw +uname -m = x86_64 +uname -r = 3.14-2-amd64 +uname -s = Linux +uname -v = #1 SMP Debian 3.14.15-2 (2014-08-09) + +/usr/bin/uname -p = unknown +/bin/uname -X = unknown + +/bin/arch = unknown +/usr/bin/arch -k = unknown +/usr/convex/getsysinfo = unknown +/usr/bin/hostinfo = unknown +/bin/machine = unknown +/usr/bin/oslevel = unknown +/bin/universe = unknown + +PATH: /usr/local/sbin +PATH: /usr/local/bin +PATH: /usr/sbin +PATH: /usr/bin +PATH: /sbin +PATH: /bin + + +## ----------- ## +## Core tests. ## +## ----------- ## + +configure:1903: checking for a BSD-compatible install +configure:1971: result: /usr/bin/install -c +configure:1985: checking for perl +configure:2003: found /usr/bin/perl +configure:2016: result: /usr/bin/perl +configure:2394: checking for chosen layout +configure:2407: result: Freeside +configure:2641: checking if database name is set +configure:2644: result: yes +configure:2700: checking for dot +configure:2716: found /usr/bin/dot +configure:2728: result: yes +configure:2756: checking for gdlib-config +configure:2784: result: no +configure:2812: checking for gpg +configure:2828: found /usr/bin/gpg +configure:2840: result: yes +configure:3185: creating ./config.status + +## ---------------------- ## +## Running config.status. ## +## ---------------------- ## + +This file was extended by RT config.status rt-4.0.21, which was +generated by GNU Autoconf 2.68. Invocation command line was + + CONFIG_FILES = + CONFIG_HEADERS = + CONFIG_LINKS = + CONFIG_COMMANDS = + $ ./config.status + +on fleetpaw + +config.status:872: creating etc/upgrade/3.8-ical-extension +config.status:872: creating etc/upgrade/4.0-customfield-checkbox-extension +config.status:872: creating etc/upgrade/split-out-cf-categories +config.status:872: creating etc/upgrade/generate-rtaddressregexp +config.status:872: creating etc/upgrade/upgrade-articles +config.status:872: creating etc/upgrade/vulnerable-passwords +config.status:872: creating sbin/rt-attributes-viewer +config.status:872: creating sbin/rt-preferences-viewer +config.status:872: creating sbin/rt-session-viewer +config.status:872: creating sbin/rt-dump-metadata +config.status:872: creating sbin/rt-setup-database +config.status:872: creating sbin/rt-test-dependencies +config.status:872: creating sbin/rt-email-digest +config.status:872: creating sbin/rt-email-dashboards +config.status:872: creating sbin/rt-clean-sessions +config.status:872: creating sbin/rt-shredder +config.status:872: creating sbin/rt-validator +config.status:872: creating sbin/rt-validate-aliases +config.status:872: creating sbin/rt-email-group-admin +config.status:872: creating sbin/rt-server +config.status:872: creating sbin/rt-server.fcgi +config.status:872: creating sbin/standalone_httpd +config.status:872: creating sbin/rt-setup-fulltext-index +config.status:872: creating sbin/rt-fulltext-indexer +config.status:872: creating bin/rt-crontool +config.status:872: creating bin/rt-mailgate +config.status:872: creating bin/rt +config.status:872: creating Makefile +config.status:872: creating etc/RT_Config.pm +config.status:872: creating lib/RT/Generated.pm +config.status:872: creating t/data/configs/apache2.2+mod_perl.conf +config.status:872: creating t/data/configs/apache2.2+fastcgi.conf + +## ---------------- ## +## Cache variables. ## +## ---------------- ## + +ac_cv_env_PERL_set= +ac_cv_env_PERL_value= +ac_cv_env_build_alias_set= +ac_cv_env_build_alias_value= +ac_cv_env_host_alias_set= +ac_cv_env_host_alias_value= +ac_cv_env_target_alias_set= +ac_cv_env_target_alias_value= +ac_cv_path_PERL=/usr/bin/perl +ac_cv_path_install='/usr/bin/install -c' +ac_cv_prog_RT_GD=no +ac_cv_prog_RT_GPG=yes +ac_cv_prog_RT_GRAPHVIZ=yes + +## ----------------- ## +## Output variables. ## +## ----------------- ## + +APACHECTL='/usr/sbin/apachectl' +BIN_OWNER='root' +COMMENT_INPLACE_LAYOUT='' +CONFIGURE_INCANT='./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pass= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2' +CONFIG_FILE_PATH='/opt/rt3/etc' +CONFIG_FILE_PATH_R='/opt/rt3/etc' +DATABASE_ENV_PREF='' +DB_DATABASE='freeside' +DB_DBA='freeside' +DB_HOST='localhost' +DB_PORT='' +DB_RT_HOST='localhost' +DB_RT_PASS='' +DB_RT_USER='freeside' +DB_TYPE='Pg' +DEFS='-DPACKAGE_NAME=\"RT\" -DPACKAGE_TARNAME=\"rt\" -DPACKAGE_VERSION=\"rt-4.0.21\" -DPACKAGE_STRING=\"RT\ rt-4.0.21\" -DPACKAGE_BUGREPORT=\"rt-bugs@bestpractical.com\" -DPACKAGE_URL=\"\"' +ECHO_C='' +ECHO_N='-n' +ECHO_T='' +INSTALL_DATA='${INSTALL} -m 644' +INSTALL_PROGRAM='${INSTALL}' +INSTALL_SCRIPT='${INSTALL}' +LIBOBJS='' +LIBS='' +LIBS_GROUP='bin' +LIBS_OWNER='root' +LOCAL_ETC_PATH='/opt/rt3/local/etc' +LOCAL_ETC_PATH_R='/opt/rt3/local/etc' +LOCAL_LEXICON_PATH='/opt/rt3/local/po' +LOCAL_LEXICON_PATH_R='/opt/rt3/local/po' +LOCAL_LIB_PATH='/opt/rt3/local/lib' +LOCAL_LIB_PATH_R='/opt/rt3/local/lib' +LOCAL_PLUGIN_PATH='/opt/rt3/local/plugins' +LOCAL_PLUGIN_PATH_R='/opt/rt3/local/plugins' +LTLIBOBJS='' +MASON_DATA_PATH='/usr/local/etc/freeside/masondata' +MASON_DATA_PATH_R='/usr/local/etc/freeside/masondata' +MASON_HTML_PATH='/var/www/freeside/rt' +MASON_HTML_PATH_R='/var/www/freeside/rt' +MASON_LOCAL_HTML_PATH='/opt/rt3/local/html' +MASON_LOCAL_HTML_PATH_R='/opt/rt3/local/html' +MASON_SESSION_PATH='/opt/rt3/var/session_data' +MASON_SESSION_PATH_R='/opt/rt3/var/session_data' +PACKAGE_BUGREPORT='rt-bugs@bestpractical.com' +PACKAGE_NAME='RT' +PACKAGE_STRING='RT rt-4.0.21' +PACKAGE_TARNAME='rt' +PACKAGE_URL='' +PACKAGE_VERSION='rt-4.0.21' +PATH_SEPARATOR=':' +PERL='/usr/bin/perl' +RTGROUP='freeside' +RT_BIN_PATH='/opt/rt3/bin' +RT_BIN_PATH_R='/opt/rt3/bin' +RT_DEVEL_MODE='0' +RT_DOC_PATH='/opt/rt3/docs' +RT_DOC_PATH_R='/opt/rt3/docs' +RT_ETC_PATH='/opt/rt3/etc' +RT_ETC_PATH_R='/opt/rt3/etc' +RT_FONT_PATH='/opt/rt3/share/fonts' +RT_FONT_PATH_R='/opt/rt3/share/fonts' +RT_GD='0' +RT_GPG='1' +RT_GRAPHVIZ='1' +RT_LEXICON_PATH='/opt/rt3/share/po' +RT_LEXICON_PATH_R='/opt/rt3/share/po' +RT_LIB_PATH='/opt/rt3/lib' +RT_LIB_PATH_R='/opt/rt3/lib' +RT_LOCAL_PATH='/opt/rt3/local' +RT_LOCAL_PATH_R='/opt/rt3/local' +RT_LOG_PATH='/opt/rt3/var/log' +RT_LOG_PATH_R='/opt/rt3/var/log' +RT_MAN_PATH='/opt/rt3/man' +RT_MAN_PATH_R='/opt/rt3/man' +RT_PATH='/opt/rt3' +RT_PATH_R='/opt/rt3' +RT_PLUGIN_PATH='/opt/rt3/plugins' +RT_PLUGIN_PATH_R='/opt/rt3/plugins' +RT_SBIN_PATH='/opt/rt3/sbin' +RT_SBIN_PATH_R='/opt/rt3/sbin' +RT_SSL_MAILGATE='0' +RT_VAR_PATH='/opt/rt3/var' +RT_VAR_PATH_R='/opt/rt3/var' +RT_VERSION_MAJOR='4' +RT_VERSION_MINOR='0' +RT_VERSION_PATCH='21' +SHELL='/bin/bash' +WEB_GROUP='freeside' +WEB_HANDLER='modperl2' +WEB_USER='freeside' +bindir='/opt/rt3/bin' +build_alias='' +customdir='/opt/rt3/local' +custometcdir='/opt/rt3/local/etc' +customhtmldir='/opt/rt3/local/html' +customlexdir='/opt/rt3/local/po' +customlibdir='/opt/rt3/local/lib' +customplugindir='/opt/rt3/local/plugins' +datadir='/opt/rt3/share' +datarootdir='${prefix}/share' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +dvidir='${docdir}' +exec_prefix='/opt/rt3' +exp_bindir='/opt/rt3/bin' +exp_customdir='/opt/rt3/local' +exp_custometcdir='/opt/rt3/local/etc' +exp_customhtmldir='/opt/rt3/local/html' +exp_customlexdir='/opt/rt3/local/po' +exp_customlibdir='/opt/rt3/local/lib' +exp_customplugindir='/opt/rt3/local/plugins' +exp_datadir='/opt/rt3/share' +exp_exec_prefix='/opt/rt3' +exp_fontdir='/opt/rt3/share/fonts' +exp_htmldir='/var/www/freeside/rt' +exp_lexdir='/opt/rt3/share/po' +exp_libdir='/opt/rt3/lib' +exp_localstatedir='/opt/rt3/var' +exp_logfiledir='/opt/rt3/var/log' +exp_mandir='/opt/rt3/man' +exp_manualdir='/opt/rt3/docs' +exp_masonstatedir='/usr/local/etc/freeside/masondata' +exp_plugindir='/opt/rt3/plugins' +exp_prefix='/opt/rt3' +exp_sbindir='/opt/rt3/sbin' +exp_sessionstatedir='/opt/rt3/var/session_data' +exp_sysconfdir='/opt/rt3/etc' +fontdir='/opt/rt3/share/fonts' +host_alias='' +htmldir='/var/www/freeside/rt' +includedir='${prefix}/include' +infodir='${datarootdir}/info' +lexdir='/opt/rt3/share/po' +libdir='/opt/rt3/lib' +libexecdir='${exec_prefix}/libexec' +localedir='${datarootdir}/locale' +localstatedir='/opt/rt3/var' +logfiledir='/opt/rt3/var/log' +mandir='/opt/rt3/man' +manualdir='/opt/rt3/docs' +masonstatedir='/usr/local/etc/freeside/masondata' +oldincludedir='/usr/include' +pdfdir='${docdir}' +plugindir='/opt/rt3/plugins' +prefix='/opt/rt3' +program_transform_name='s,x,x,' +psdir='${docdir}' +rt_layout_name='Freeside' +rt_version_major='4' +rt_version_minor='0' +rt_version_patch='21' +sbindir='/opt/rt3/sbin' +sessionstatedir='/opt/rt3/var/session_data' +sharedstatedir='${prefix}/com' +sysconfdir='/opt/rt3/etc' +target_alias='' + +## ----------- ## +## confdefs.h. ## +## ----------- ## + +/* confdefs.h */ +#define PACKAGE_NAME "RT" +#define PACKAGE_TARNAME "rt" +#define PACKAGE_VERSION "rt-4.0.21" +#define PACKAGE_STRING "RT rt-4.0.21" +#define PACKAGE_BUGREPORT "rt-bugs@bestpractical.com" +#define PACKAGE_URL "" + +configure: exit 0 diff --git a/rt/config.pld b/rt/config.pld new file mode 100644 index 000000000..787b7ec59 --- /dev/null +++ b/rt/config.pld @@ -0,0 +1,23 @@ +(test "x$prefix" = "xNONE" || test "x$prefix" = "x") && prefix=/opt/rt3 +(test "x$exec_prefix" = "xNONE" || test "x$exec_prefix" = "x") && exec_prefix=${prefix} +bindir=${exec_prefix}/bin +sbindir=${exec_prefix}/sbin +sysconfdir=${prefix}/etc +mandir=${prefix}/man +(test "x$plugindir" = "xNONE" || test "x$plugindir" = "x") && plugindir=${prefix}/plugins +libdir=${prefix}/lib +datadir=${prefix}/share +htmldir=/var/www/freeside/rt +(test "x$fontdir" = "xNONE" || test "x$fontdir" = "x") && fontdir=${datadir}/fonts +(test "x$lexdir" = "xNONE" || test "x$lexdir" = "x") && lexdir=${datadir}/po +(test "x$manualdir" = "xNONE" || test "x$manualdir" = "x") && manualdir=${prefix}/docs +localstatedir=${prefix}/var +(test "x$logfiledir" = "xNONE" || test "x$logfiledir" = "x") && logfiledir=${localstatedir}/log +(test "x$masonstatedir" = "xNONE" || test "x$masonstatedir" = "x") && masonstatedir=/usr/local/etc/freeside/masondata +(test "x$sessionstatedir" = "xNONE" || test "x$sessionstatedir" = "x") && sessionstatedir=${localstatedir}/session_data +(test "x$customdir" = "xNONE" || test "x$customdir" = "x") && customdir=${prefix}/local +(test "x$custometcdir" = "xNONE" || test "x$custometcdir" = "x") && custometcdir=${customdir}/etc +(test "x$customhtmldir" = "xNONE" || test "x$customhtmldir" = "x") && customhtmldir=${customdir}/html +(test "x$customlexdir" = "xNONE" || test "x$customlexdir" = "x") && customlexdir=${customdir}/po +(test "x$customlibdir" = "xNONE" || test "x$customlibdir" = "x") && customlibdir=${customdir}/lib +(test "x$customplugindir" = "xNONE" || test "x$customplugindir" = "x") && customplugindir=${customdir}/plugins diff --git a/rt/config.status b/rt/config.status new file mode 100755 index 000000000..24c5f4d6a --- /dev/null +++ b/rt/config.status @@ -0,0 +1,1102 @@ +#! /bin/bash +# Generated by configure. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=${CONFIG_SHELL-/bin/bash} +export SHELL +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +# Save the log message, to keep $0 and so on meaningful, and to +# 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.21, which was +generated by GNU Autoconf 2.68. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +# Files that config.status was made for. +config_files=" etc/upgrade/3.8-ical-extension etc/upgrade/4.0-customfield-checkbox-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 Makefile etc/RT_Config.pm lib/RT/Generated.pm t/data/configs/apache2.2+mod_perl.conf t/data/configs/apache2.2+fastcgi.conf" + +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to <rt-bugs@bestpractical.com>." + +ac_cs_config="'--enable-layout=Freeside' '--with-db-type=Pg' '--with-db-dba=freeside' '--with-db-database=freeside' '--with-db-rt-user=freeside' '--with-db-rt-pass=' '--with-web-user=freeside' '--with-web-group=freeside' '--with-rt-group=freeside' '--with-web-handler=modperl2'" +ac_cs_version="\ +RT config.status rt-4.0.21 +configured by ./configure, generated by GNU Autoconf 2.68, + with options \"$ac_cs_config\" + +Copyright (C) 2010 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='/home/ivan/freeside/rt' +srcdir='.' +INSTALL='/usr/bin/install -c' +test -n "$AWK" || AWK=awk +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +if $ac_cs_recheck; then + set X '/bin/bash' './configure' '--enable-layout=Freeside' '--with-db-type=Pg' '--with-db-dba=freeside' '--with-db-database=freeside' '--with-db-rt-user=freeside' '--with-db-rt-pass=' '--with-web-user=freeside' '--with-web-group=freeside' '--with-rt-group=freeside' '--with-web-handler=modperl2' $ac_configure_extra_args --no-create --no-recursion + shift + $as_echo "running CONFIG_SHELL=/bin/bash $*" >&6 + CONFIG_SHELL='/bin/bash' + export CONFIG_SHELL + exec "$@" +fi + +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "etc/upgrade/3.8-ical-extension") CONFIG_FILES="$CONFIG_FILES etc/upgrade/3.8-ical-extension" ;; + "etc/upgrade/4.0-customfield-checkbox-extension") CONFIG_FILES="$CONFIG_FILES etc/upgrade/4.0-customfield-checkbox-extension" ;; + "etc/upgrade/split-out-cf-categories") CONFIG_FILES="$CONFIG_FILES etc/upgrade/split-out-cf-categories" ;; + "etc/upgrade/generate-rtaddressregexp") CONFIG_FILES="$CONFIG_FILES etc/upgrade/generate-rtaddressregexp" ;; + "etc/upgrade/upgrade-articles") CONFIG_FILES="$CONFIG_FILES etc/upgrade/upgrade-articles" ;; + "etc/upgrade/vulnerable-passwords") CONFIG_FILES="$CONFIG_FILES etc/upgrade/vulnerable-passwords" ;; + "sbin/rt-attributes-viewer") CONFIG_FILES="$CONFIG_FILES sbin/rt-attributes-viewer" ;; + "sbin/rt-preferences-viewer") CONFIG_FILES="$CONFIG_FILES sbin/rt-preferences-viewer" ;; + "sbin/rt-session-viewer") CONFIG_FILES="$CONFIG_FILES sbin/rt-session-viewer" ;; + "sbin/rt-dump-metadata") CONFIG_FILES="$CONFIG_FILES sbin/rt-dump-metadata" ;; + "sbin/rt-setup-database") CONFIG_FILES="$CONFIG_FILES sbin/rt-setup-database" ;; + "sbin/rt-test-dependencies") CONFIG_FILES="$CONFIG_FILES sbin/rt-test-dependencies" ;; + "sbin/rt-email-digest") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-digest" ;; + "sbin/rt-email-dashboards") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-dashboards" ;; + "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" ;; + "sbin/standalone_httpd") CONFIG_FILES="$CONFIG_FILES sbin/standalone_httpd" ;; + "sbin/rt-setup-fulltext-index") CONFIG_FILES="$CONFIG_FILES sbin/rt-setup-fulltext-index" ;; + "sbin/rt-fulltext-indexer") CONFIG_FILES="$CONFIG_FILES sbin/rt-fulltext-indexer" ;; + "bin/rt-crontool") CONFIG_FILES="$CONFIG_FILES bin/rt-crontool" ;; + "bin/rt-mailgate") CONFIG_FILES="$CONFIG_FILES bin/rt-mailgate" ;; + "bin/rt") CONFIG_FILES="$CONFIG_FILES bin/rt" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "etc/RT_Config.pm") CONFIG_FILES="$CONFIG_FILES etc/RT_Config.pm" ;; + "lib/RT/Generated.pm") CONFIG_FILES="$CONFIG_FILES lib/RT/Generated.pm" ;; + "t/data/configs/apache2.2+mod_perl.conf") CONFIG_FILES="$CONFIG_FILES t/data/configs/apache2.2+mod_perl.conf" ;; + "t/data/configs/apache2.2+fastcgi.conf") CONFIG_FILES="$CONFIG_FILES t/data/configs/apache2.2+fastcgi.conf" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +cat >>"$ac_tmp/subs1.awk" <<\_ACAWK && +S["LTLIBOBJS"]="" +S["LIBOBJS"]="" +S["RT_LOG_PATH_R"]="/opt/rt3/var/log" +S["LOCAL_PLUGIN_PATH_R"]="/opt/rt3/local/plugins" +S["LOCAL_LIB_PATH_R"]="/opt/rt3/local/lib" +S["LOCAL_LEXICON_PATH_R"]="/opt/rt3/local/po" +S["MASON_LOCAL_HTML_PATH_R"]="/opt/rt3/local/html" +S["LOCAL_ETC_PATH_R"]="/opt/rt3/local/etc" +S["MASON_HTML_PATH_R"]="/var/www/freeside/rt" +S["MASON_SESSION_PATH_R"]="/opt/rt3/var/session_data" +S["MASON_DATA_PATH_R"]="/usr/local/etc/freeside/masondata" +S["RT_PLUGIN_PATH_R"]="/opt/rt3/plugins" +S["RT_LEXICON_PATH_R"]="/opt/rt3/share/po" +S["RT_FONT_PATH_R"]="/opt/rt3/share/fonts" +S["RT_MAN_PATH_R"]="/opt/rt3/man" +S["RT_VAR_PATH_R"]="/opt/rt3/var" +S["RT_SBIN_PATH_R"]="/opt/rt3/sbin" +S["RT_BIN_PATH_R"]="/opt/rt3/bin" +S["CONFIG_FILE_PATH_R"]="/opt/rt3/etc" +S["RT_ETC_PATH_R"]="/opt/rt3/etc" +S["RT_LIB_PATH_R"]="/opt/rt3/lib" +S["RT_LOCAL_PATH_R"]="/opt/rt3/local" +S["RT_DOC_PATH_R"]="/opt/rt3/docs" +S["RT_PATH_R"]="/opt/rt3" +S["RT_LOG_PATH"]="/opt/rt3/var/log" +S["LOCAL_PLUGIN_PATH"]="/opt/rt3/local/plugins" +S["LOCAL_LIB_PATH"]="/opt/rt3/local/lib" +S["LOCAL_LEXICON_PATH"]="/opt/rt3/local/po" +S["MASON_LOCAL_HTML_PATH"]="/opt/rt3/local/html" +S["LOCAL_ETC_PATH"]="/opt/rt3/local/etc" +S["MASON_HTML_PATH"]="/var/www/freeside/rt" +S["MASON_SESSION_PATH"]="/opt/rt3/var/session_data" +S["MASON_DATA_PATH"]="/usr/local/etc/freeside/masondata" +S["RT_PLUGIN_PATH"]="/opt/rt3/plugins" +S["RT_FONT_PATH"]="/opt/rt3/share/fonts" +S["RT_MAN_PATH"]="/opt/rt3/man" +S["RT_VAR_PATH"]="/opt/rt3/var" +S["RT_SBIN_PATH"]="/opt/rt3/sbin" +S["RT_BIN_PATH"]="/opt/rt3/bin" +S["CONFIG_FILE_PATH"]="/opt/rt3/etc" +S["RT_ETC_PATH"]="/opt/rt3/etc" +S["RT_LEXICON_PATH"]="/opt/rt3/share/po" +S["RT_LIB_PATH"]="/opt/rt3/lib" +S["RT_LOCAL_PATH"]="/opt/rt3/local" +S["RT_DOC_PATH"]="/opt/rt3/docs" +S["RT_PATH"]="/opt/rt3" +S["RT_VERSION_PATCH"]="21" +S["RT_VERSION_MINOR"]="0" +S["RT_VERSION_MAJOR"]="4" +S["RT_SSL_MAILGATE"]="0" +S["RT_GPG"]="1" +S["RT_GD"]="0" +S["RT_GRAPHVIZ"]="1" +S["RT_DEVEL_MODE"]="0" +S["APACHECTL"]="/usr/sbin/apachectl" +S["RTGROUP"]="freeside" +S["WEB_GROUP"]="freeside" +S["WEB_USER"]="freeside" +S["DB_RT_PASS"]="" +S["DB_RT_USER"]="freeside" +S["DB_DATABASE"]="freeside" +S["DB_DBA"]="freeside" +S["DB_RT_HOST"]="localhost" +S["DB_PORT"]="" +S["DB_HOST"]="localhost" +S["DATABASE_ENV_PREF"]="" +S["DB_TYPE"]="Pg" +S["LIBS_GROUP"]="bin" +S["LIBS_OWNER"]="root" +S["BIN_OWNER"]="root" +S["COMMENT_INPLACE_LAYOUT"]="" +S["rt_layout_name"]="Freeside" +S["exp_customlibdir"]="/opt/rt3/local/lib" +S["customlibdir"]="/opt/rt3/local/lib" +S["exp_customlexdir"]="/opt/rt3/local/po" +S["customlexdir"]="/opt/rt3/local/po" +S["exp_customhtmldir"]="/opt/rt3/local/html" +S["customhtmldir"]="/opt/rt3/local/html" +S["exp_customplugindir"]="/opt/rt3/local/plugins" +S["customplugindir"]="/opt/rt3/local/plugins" +S["exp_custometcdir"]="/opt/rt3/local/etc" +S["custometcdir"]="/opt/rt3/local/etc" +S["exp_customdir"]="/opt/rt3/local" +S["customdir"]="/opt/rt3/local" +S["exp_sessionstatedir"]="/opt/rt3/var/session_data" +S["sessionstatedir"]="/opt/rt3/var/session_data" +S["exp_masonstatedir"]="/usr/local/etc/freeside/masondata" +S["masonstatedir"]="/usr/local/etc/freeside/masondata" +S["exp_logfiledir"]="/opt/rt3/var/log" +S["logfiledir"]="/opt/rt3/var/log" +S["exp_localstatedir"]="/opt/rt3/var" +S["exp_plugindir"]="/opt/rt3/plugins" +S["plugindir"]="/opt/rt3/plugins" +S["exp_manualdir"]="/opt/rt3/docs" +S["manualdir"]="/opt/rt3/docs" +S["exp_fontdir"]="/opt/rt3/share/fonts" +S["fontdir"]="/opt/rt3/share/fonts" +S["exp_htmldir"]="/var/www/freeside/rt" +S["exp_datadir"]="/opt/rt3/share" +S["exp_lexdir"]="/opt/rt3/share/po" +S["lexdir"]="/opt/rt3/share/po" +S["exp_libdir"]="/opt/rt3/lib" +S["exp_mandir"]="/opt/rt3/man" +S["exp_sysconfdir"]="/opt/rt3/etc" +S["exp_sbindir"]="/opt/rt3/sbin" +S["exp_bindir"]="/opt/rt3/bin" +S["exp_exec_prefix"]="/opt/rt3" +S["exp_prefix"]="/opt/rt3" +S["WEB_HANDLER"]="modperl2" +S["PERL"]="/usr/bin/perl" +S["INSTALL_DATA"]="${INSTALL} -m 644" +S["INSTALL_SCRIPT"]="${INSTALL}" +S["INSTALL_PROGRAM"]="${INSTALL}" +S["rt_version_patch"]="21" +S["rt_version_minor"]="0" +S["rt_version_major"]="4" +S["CONFIGURE_INCANT"]="./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pa"\ +"ss= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2" +S["target_alias"]="" +S["host_alias"]="" +S["build_alias"]="" +S["LIBS"]="" +S["ECHO_T"]="" +S["ECHO_N"]="-n" +S["ECHO_C"]="" +S["DEFS"]="-DPACKAGE_NAME=\\\"RT\\\" -DPACKAGE_TARNAME=\\\"rt\\\" -DPACKAGE_VERSION=\\\"rt-4.0.21\\\" -DPACKAGE_STRING=\\\"RT\\ rt-4.0.21\\\" -DPACKAGE_BUGREPORT=\\\"rt-bugs@best"\ +"practical.com\\\" -DPACKAGE_URL=\\\"\\\"" +S["mandir"]="/opt/rt3/man" +S["localedir"]="${datarootdir}/locale" +S["libdir"]="/opt/rt3/lib" +S["psdir"]="${docdir}" +S["pdfdir"]="${docdir}" +S["dvidir"]="${docdir}" +S["htmldir"]="/var/www/freeside/rt" +S["infodir"]="${datarootdir}/info" +S["docdir"]="${datarootdir}/doc/${PACKAGE_TARNAME}" +S["oldincludedir"]="/usr/include" +S["includedir"]="${prefix}/include" +S["localstatedir"]="/opt/rt3/var" +S["sharedstatedir"]="${prefix}/com" +S["sysconfdir"]="/opt/rt3/etc" +S["datadir"]="/opt/rt3/share" +S["datarootdir"]="${prefix}/share" +S["libexecdir"]="${exec_prefix}/libexec" +S["sbindir"]="/opt/rt3/sbin" +S["bindir"]="/opt/rt3/bin" +S["program_transform_name"]="s,x,x," +S["prefix"]="/opt/rt3" +S["exec_prefix"]="/opt/rt3" +S["PACKAGE_URL"]="" +S["PACKAGE_BUGREPORT"]="rt-bugs@bestpractical.com" +S["PACKAGE_STRING"]="RT rt-4.0.21" +S["PACKAGE_VERSION"]="rt-4.0.21" +S["PACKAGE_TARNAME"]="rt" +S["PACKAGE_NAME"]="RT" +S["PATH_SEPARATOR"]=":" +S["SHELL"]="/bin/bash" +_ACAWK +cat >>"$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} + ac_datarootdir_hack=' + s&@datadir@&/opt/rt3/share&g + s&@docdir@&${datarootdir}/doc/${PACKAGE_TARNAME}&g + s&@infodir@&${datarootdir}/info&g + s&@localedir@&${datarootdir}/locale&g + s&@mandir@&/opt/rt3/man&g + s&\${datarootdir}&${prefix}/share&g' ;; +esac +ac_sed_extra="/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +} + +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + + + case $ac_file$ac_mode in + "etc/upgrade/3.8-ical-extension":F) chmod ug+x $ac_file + ;; + "etc/upgrade/4.0-customfield-checkbox-extension":F) chmod ug+x $ac_file + ;; + "etc/upgrade/split-out-cf-categories":F) chmod ug+x $ac_file + ;; + "etc/upgrade/generate-rtaddressregexp":F) chmod ug+x $ac_file + ;; + "etc/upgrade/upgrade-articles":F) chmod ug+x $ac_file + ;; + "etc/upgrade/vulnerable-passwords":F) chmod ug+x $ac_file + ;; + "sbin/rt-attributes-viewer":F) chmod ug+x $ac_file + ;; + "sbin/rt-preferences-viewer":F) chmod ug+x $ac_file + ;; + "sbin/rt-session-viewer":F) chmod ug+x $ac_file + ;; + "sbin/rt-dump-metadata":F) chmod ug+x $ac_file + ;; + "sbin/rt-setup-database":F) chmod ug+x $ac_file + ;; + "sbin/rt-test-dependencies":F) chmod ug+x $ac_file + ;; + "sbin/rt-email-digest":F) chmod ug+x $ac_file + ;; + "sbin/rt-email-dashboards":F) chmod ug+x $ac_file + ;; + "sbin/rt-clean-sessions":F) chmod ug+x $ac_file + ;; + "sbin/rt-shredder":F) chmod ug+x $ac_file + ;; + "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 + ;; + "sbin/rt-server.fcgi":F) chmod ug+x $ac_file + ;; + "sbin/standalone_httpd":F) chmod ug+x $ac_file + ;; + "sbin/rt-setup-fulltext-index":F) chmod ug+x $ac_file + ;; + "sbin/rt-fulltext-indexer":F) chmod ug+x $ac_file + ;; + "bin/rt-crontool":F) chmod ug+x $ac_file + ;; + "bin/rt-mailgate":F) chmod ug+x $ac_file + ;; + "bin/rt":F) chmod ug+x $ac_file + ;; + + esac +done # for ac_tag + + +as_fn_exit 0 diff --git a/rt/configure b/rt/configure index 616017fb1..f2f604103 100755 --- a/rt/configure +++ b/rt/configure @@ -1,14 +1,12 @@ #! /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.21. +# Generated by GNU Autoconf 2.69 for RT rt-4.0.22. # # Report bugs to <rt-bugs@bestpractical.com>. # # -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software -# Foundation, Inc. +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation @@ -137,6 +135,31 @@ export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh @@ -170,7 +193,8 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : else exitcode=1; echo positional parameters were not saved. fi -test x\$exitcode = x0 || exit 1" +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && @@ -214,21 +238,25 @@ IFS=$as_save_IFS if test "x$CONFIG_SHELL" != x; then : - # We cannot yet assume a decent shell, so we have to provide a - # neutralization value for shells without unset; and this also - # works around shells that cannot unset nonexistent variables. - # Preserve -v and -x to the replacement shell. - BASH_ENV=/dev/null - ENV=/dev/null - (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV - export CONFIG_SHELL - case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; - esac - exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 fi if test x$as_have_required = xno; then : @@ -331,6 +359,14 @@ $as_echo X"$as_dir" | } # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take @@ -452,6 +488,10 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). @@ -486,16 +526,16 @@ if (echo >conf$$.file) 2>/dev/null; then # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -p'. + # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -p' + as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else - as_ln_s='cp -p' + as_ln_s='cp -pR' fi else - as_ln_s='cp -p' + as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null @@ -507,28 +547,8 @@ else as_mkdir_p=false fi -if test -x / >/dev/null 2>&1; then - as_test_x='test -x' -else - if ls -dL / >/dev/null 2>&1; then - as_ls_L_option=L - else - as_ls_L_option= - fi - as_test_x=' - eval sh -c '\'' - if test -d "$1"; then - test -d "$1/."; - else - case $1 in #( - -*)set "./$1";; - esac; - case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( - ???[sx]*):;;*)false;;esac;fi - '\'' sh - ' -fi -as_executable_p=$as_test_x +as_test_x='test -x' +as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -560,8 +580,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='RT' PACKAGE_TARNAME='rt' -PACKAGE_VERSION='rt-4.0.21' -PACKAGE_STRING='RT rt-4.0.21' +PACKAGE_VERSION='rt-4.0.22' +PACKAGE_STRING='RT rt-4.0.22' PACKAGE_BUGREPORT='rt-bugs@bestpractical.com' PACKAGE_URL='' @@ -1212,8 +1232,6 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe - $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. - If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -1299,7 +1317,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.21 to adapt to many kinds of systems. +\`configure' configures RT rt-4.0.22 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1360,7 +1378,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of RT rt-4.0.21:";; + short | recursive ) echo "Configuration of RT rt-4.0.22:";; esac cat <<\_ACEOF @@ -1477,10 +1495,10 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -RT configure rt-4.0.21 -generated by GNU Autoconf 2.68 +RT configure rt-4.0.22 +generated by GNU Autoconf 2.69 -Copyright (C) 2010 Free Software Foundation, Inc. +Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1494,8 +1512,8 @@ 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.21, which was -generated by GNU Autoconf 2.68. Invocation command line was +It was created by RT $as_me rt-4.0.22, which was +generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -1851,7 +1869,7 @@ rt_version_major=4 rt_version_minor=0 -rt_version_patch=21 +rt_version_patch=22 test "x$rt_version_major" = 'x' && rt_version_major=0 test "x$rt_version_minor" = 'x' && rt_version_minor=0 @@ -1923,7 +1941,7 @@ case $as_dir/ in #(( # by default. for ac_prog in ginstall scoinst install; do for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then + if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then if test $ac_prog = install && grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. @@ -1998,7 +2016,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PERL="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2711,7 +2729,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RT_GRAPHVIZ=""yes"" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2767,7 +2785,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RT_GD=""yes"" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2823,7 +2841,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RT_GPG=""yes"" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -3475,16 +3493,16 @@ if (echo >conf$$.file) 2>/dev/null; then # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -p'. + # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -p' + as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else - as_ln_s='cp -p' + as_ln_s='cp -pR' fi else - as_ln_s='cp -p' + as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null @@ -3544,28 +3562,16 @@ else as_mkdir_p=false fi -if test -x / >/dev/null 2>&1; then - as_test_x='test -x' -else - if ls -dL / >/dev/null 2>&1; then - as_ls_L_option=L - else - as_ls_L_option= - fi - as_test_x=' - eval sh -c '\'' - if test -d "$1"; then - test -d "$1/."; - else - case $1 in #( - -*)set "./$1";; - esac; - case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( - ???[sx]*):;;*)false;;esac;fi - '\'' sh - ' -fi -as_executable_p=$as_test_x + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -3586,8 +3592,8 @@ 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.21, which was -generated by GNU Autoconf 2.68. Invocation command line was +This file was extended by RT $as_me rt-4.0.22, which was +generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -3639,11 +3645,11 @@ _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.21 -configured by $0, generated by GNU Autoconf 2.68, +RT config.status rt-4.0.22 +configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" -Copyright (C) 2010 Free Software Foundation, Inc. +Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -3721,7 +3727,7 @@ fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then - set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' diff --git a/rt/devel/tools/localhost.crt b/rt/devel/tools/localhost.crt new file mode 100644 index 000000000..bc8e572cd --- /dev/null +++ b/rt/devel/tools/localhost.crt @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICpjCCAY4CCQDLtMptx45HuDANBgkqhkiG9w0BAQUFADAUMRIwEAYDVQQDEwls +b2NhbGhvc3QwIBcNMTIwMjE3MjIxMTU3WhgPMjExMjAxMjQyMjExNTdaMBQxEjAQ +BgNVBAMTCWxvY2FsaG9zdDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEB +AKokK5sAKbNkJDoOInDQpwRxDDfanXKUR7MK761G2gWmUpxy+hlUn457VLgDKgDp +s3gSUk0x3rsXcMxpsSDQ+E37kz5DnbPGSGdiS5tJD6VoQ2NsMfvrY1pZFWNv8wHu +c4MDtStxsIxvZHjqguWeVUsXLKSfGEMTQ/MbKbn4d/7FSRpQDum2o3AsxHi4VbrS +aWXRgCfcPlwaoOSc73lCD0kuXIl66wO8DBQOqqBtkuS59BcH+cq1T5wwKzMdJNfp +Rx0TXISGUa4DSbTjqfAAJe4TzavH73PgNjXBl6+GsGb5/pf8Zad+t62xRcocDfOQ +5e2ASmInsDtlSX0pfLfBHg0CAwEAATANBgkqhkiG9w0BAQUFAAOCAQEAUuiDKlBN +RcR/YYkk/hCgDB4ronO3AO+d264Y3vDK+JsH2lI6/kwxpmJj+bA2IVM+eM5NrcFh +zEm+LKnyz4EvmxXTI4gI1iFPhOP4NJYmMtyKGavlZP3gNW4JQRYOiA0vQ2Egcngo +uW2k7xUaNPPkpHptkI0P1jLVl4bX/qKA6tzrmwsmdwNOW9j9zk9BOq8HVvduBDeU +XFsrdmN4EgD0nU39olaArg/RqMacIfCfKqYdRo9OSbBfQ7x2di9HgI1h2VVfPGi5 +cDRyLlpAY9KNuuStutcFMoQbdwKU/0GFkRuguFPJbIcDg7nhZDXRMU+XugQ8dsZ/ +0VgszAIRc510nA== +-----END CERTIFICATE----- diff --git a/rt/devel/tools/localhost.key b/rt/devel/tools/localhost.key new file mode 100644 index 000000000..4b9dfe2df --- /dev/null +++ b/rt/devel/tools/localhost.key @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEogIBAAKCAQEAqiQrmwAps2QkOg4icNCnBHEMN9qdcpRHswrvrUbaBaZSnHL6 +GVSfjntUuAMqAOmzeBJSTTHeuxdwzGmxIND4TfuTPkOds8ZIZ2JLm0kPpWhDY2wx +++tjWlkVY2/zAe5zgwO1K3GwjG9keOqC5Z5VSxcspJ8YQxND8xspufh3/sVJGlAO +6bajcCzEeLhVutJpZdGAJ9w+XBqg5JzveUIPSS5ciXrrA7wMFA6qoG2S5Ln0Fwf5 +yrVPnDArMx0k1+lHHRNchIZRrgNJtOOp8AAl7hPNq8fvc+A2NcGXr4awZvn+l/xl +p363rbFFyhwN85Dl7YBKYiewO2VJfSl8t8EeDQIDAQABAoIBAGeZsrulM786QRzg +snQDeU+pDomMIsc8JxSMmjjmpac/CZqeIFAASU/XJVUPCCqaI1//uAGtVjSSJ2sx +CFw1Ip1JjPUi8woeuMPLBMK/kDll7XLC1QTS5iKDkBSGfHA2pDuorE6R4bEBuyot +khsDeGhK6jIrdfiR6JRFe/jzpQ2KUV7PDKhcGjWdCCGoss7s2d0Gx4UdlYn456Dr +atPLXU9Aspg7uIUSO44Zwal03k25S0EW4WjdFCx3+1WqXs8l+XNXlqowZSL8qjOy +cL2H5bpElE+NjSsHtTZdzC8jcDhbIRp8cZD32t+BRY5gqodKw+Z3MmblL2b3/qPi +xNMaq8ECgYEA3ACjPUhRb7kYMgmowOXR/HL9Aht+4uCM+UM/pz0S4rn4MooBuCwv +Nc0oFi5wFNJpFsOsiJwik7re1/olPPneZWgZWgBoiQl4+OB5hzvLc56B9Ez3Z84X +19BxKcUaf5gXjxVAAAeKxn8ZbL/OHB3WvYP4zsIO1J+ijOe2LZJFEpUCgYEAxfr4 +RsK8avAdgOC0e/uB007rtiErCIaVnK/1WMPwWb5FxDkkl31MTB6oLO/JU5zfCsE1 +ROtnehB69c73sokWzAqMCuVFs+M0Owq1Kdm63b1k0wtUZL7v3wfGoUgZFL/65LDg +RQ2Grntul5H7XS9c9v7Tn9GSo8VIbej6fvPPN5kCgYAqbL0N7ko1/z2ZOJ+gQzFR +O2Nq6p53ZdIJp1w5BeAEdNRV+qMGPw8DkwJt9JqMiV7WkvlMhr9sOZcLkyNnNNAc +QgzRfE6sTnVTmQYWfANp0mFBGS6EiAu1BG8uHOJVRKEWaISk/M9YI95lSD+Y0HA+ +r5plVKrDed1AytYox5ImWQKBgC/VNQsTnaZQoTA0GiciWvmMxdJZLSaALcGPmb16 +iaWFHSINlFOtiDOT7Jn+zSuQaSsWByLBpVyOgsbE3H+cM4/UtIUlY7PUnxfsvFyC +KG3Ohn+e6yL0JsxB+rGY08Z5o8qBGY5VeEbLt6qTMKIRAWsDommonr9GuPslIPBv +Q49xAoGAI7LBHEJtPTJx56EcKicST++NzUYha7E8nkqogs9oTTpdT6n+viHDCNud +YUUK2slnEvgOPtNEkf1kHTqcajKZmIVpQi1cZqKzPCgk49JM+2OU+98qFR8UKe8i +s5t09zDVhy9Hy+MaASqbU1AQT9bWbyfsgormjQ5jzadDdP5zovE= +-----END RSA PRIVATE KEY----- diff --git a/rt/devel/tools/mime.types b/rt/devel/tools/mime.types new file mode 100644 index 000000000..83ef24d9a --- /dev/null +++ b/rt/devel/tools/mime.types @@ -0,0 +1,4 @@ +# This is a mime.types for only the file types which we serve +# statically (those that Apache might care about). +image/gif gif +image/png png diff --git a/rt/devel/tools/rt-apache b/rt/devel/tools/rt-apache new file mode 100644 index 000000000..ba130deed --- /dev/null +++ b/rt/devel/tools/rt-apache @@ -0,0 +1,439 @@ +#!/usr/bin/env perl + +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 Getopt::Long; +use FindBin; +use Pod::Usage; +use File::Spec::Functions qw(rel2abs); + +my %opt = ( + root => ($ENV{RTHOME} || "/opt/rt4"), + + fcgid => 0, + fastcgi => 0, + perl => 0, + + modules => "/usr/lib/apache2/modules", +); + +GetOptions( \%opt, + "root=s", + + "rt3|3!", + + "fcgid!", + "fastcgi!", + "perl!", + + "port|p=i", + "ssl:i", + "single|X", + + "modules=s", + + "help|h|?", +) or pod2usage( 1 ); +pod2usage( {verbose => 2} ) if $opt{help}; + +# All paths must be absolute +$opt{$_} = rel2abs($opt{$_}) + for qw(root modules); + +# Determine what module to use +my $mod; +if ($opt{fcgid} + $opt{fastcgi} + $opt{perl} > 1) { + die "Can only supply one of fcgid, fastcgi, or perl\n"; +} elsif ($opt{fcgid} + $opt{fastcgi} + $opt{perl} == 0) { + my @guess = qw(fastcgi fcgid perl); + @guess = grep {-f "$opt{modules}/mod_$_.so"} @guess; + die "Neither mod_fcgid, mod_fastcgi, nor mod_perl are installed; aborting\n" + unless @guess; + warn "No deployment given -- assuming mod_$guess[0] deployment\n"; + $mod = $guess[0]; +} else { + $mod = (grep {$opt{$_}} qw(fastcgi fcgid perl))[0]; +} + +# Sanity check that the root contains an RT install +die "$opt{root} doesn't look like an RT install\n" + unless -e "$opt{root}/lib/RT.pm"; + +# Detect if we are actually rt3 +if (not -e "$opt{root}/sbin/rt-server.fcgi" + and -e "$opt{root}/bin/mason_handler.fcgi") { + $opt{rt3}++; + warn "RT3 install detected!\n"; +} + +# Parse etc/RT_SiteConfig.pm for the default port +my $RTCONF; +$opt{port} ||= parseconf( "WebPort" ); +unless ($opt{port}) { + warn "Defaulting to port 8888\n"; + $opt{port} = 8888; +} + +# Set ssl port if they want it but didn't provide a number +$opt{ssl} = 4430 if defined $opt{ssl} and not $opt{ssl}; + +# Parse out the WebPath +my $path = parseconf( "WebPath" ) || ""; + +my $template = join("", <DATA>); +$template =~ s/\$PORT/$opt{port}/g; +$template =~ s!\$PATH/!$path/!g; +$template =~ s!\$PATH!$path || "/"!ge; +$template =~ s/\$SSL/$opt{ssl} || 0/ge; +$template =~ s/\$RTHOME/$opt{root}/g; +$template =~ s/\$MODULES/$opt{modules}/g; +$template =~ s/\$TOOLS/$FindBin::Bin/g; +$template =~ s/\$PROCESSES/$opt{single} ? 1 : 3/ge; + +my $conf = "$opt{root}/var/apache.conf"; +open(CONF, ">", $conf) + or die "Can't write $conf: $!"; +print CONF $template; +close CONF; + +my @opts = ("-f", $conf, "-D" . uc($mod) ); +push @opts, "-DSSL" if $opt{ssl}; +push @opts, "-DRT3" if $opt{rt3}; +push @opts, "-DSINGLE" if $opt{single}; + +# Wait for a previous run to terminate +if ( open( PIDFILE, "<", "$opt{root}/var/apache2.pid") ) { + my $pid = <PIDFILE>; + chomp $pid; + close PIDFILE; + if ($pid and kill 0, $pid) { + warn "Waiting for previous run (pid $pid) to finish...\n"; + sleep 1 while kill 0, $pid; + } +} + +# Clean out the log in preparation +my $log = "$opt{root}/var/log/apache-error.log"; +unlink($log); + +# Start 'er up +warn "Starting apache server on http://localhost:$opt{port}$path/" + . ($opt{ssl} ? " and https://localhost:$opt{ssl}$path/" : "") . "\n"; +!system("apache2", @opts, "-k", "start") + or die "Can't exec apache2: $@"; +# Ignore the return value, as we expect it to be ^C'd +system("tail", "-f", $log); +warn "Shutting down apache...\n"; +!system("apache2", @opts, "-k", "stop") + or die "Can't exec apache2: $@"; + + +sub parseconf { + my ($optname) = @_; + # We're going to be evil, and try to parse the config + unless (defined $RTCONF) { + unless ( open(CONF, "<", "$opt{root}/etc/RT_SiteConfig.pm") ) { + warn "Can't open $opt{root}/etc/RT_SiteConfig.pm: $!\n"; + $RTCONF = ""; + return; + } + $RTCONF = join("", <CONF>); + close CONF; + } + + return unless $RTCONF =~ /^\s*Set\(\s*\$$optname\s*(?:,|=>)\s*['"]?(.*?)['"]?\s*\)/m; + return $1; +} + +=head1 NAME + +rt-apache - Wrapper to start Apache running RT + +=head1 DESCRIPTION + +This script exists to make it easier to run RT under Apache for testing. +It is not intended as a way to deploy RT, or to provide example Apache +configuration for RT. For instructions on how to deploy RT with Apache, +please read the provided F<docs/web_deployment.pod> file. + +Running this script will start F<apache2> with a custom-built +configuration file, built based on command-line options and the contents +of your F<RT_SiteConfig.pm>. It will work with either RT 3.8.x or RT +4.0.x. As it is primarily for simple testing, it runs Apache as the +current user. + +=head1 OPTIONS + +C<rt-apache> will parse your F<RT_SiteConfig.pm> for its C<WebPath> and +C<WebPort> configuration, and adjust its defaults accordingly. + +=over + +=item --root B<path> + +The path to the RT install to serve. This defaults to the C<RTHOME> +environment variable, or C</opt/rt4>. + +=item --fastcgi, --fcgid, --perl + +Determines the Apache module which is used. By default, the first one +of that list which exists will be used. See also L</--modules>. + +=item --port B<number> + +Choses the port to listen on. By default, this is parsed from the +F<RT_SiteConfig.pm>, and falling back to 8888. + +=item --ssl [B<number>] + +Also listens on the provided port with HTTPS, using a self-signed +certificate for C<localhost>. If the port number is not specified, +defaults to port 4430. + +=item --single, -X + +Run only one process or thread, for ease of debugging. + +=item --rt3, -3 + +Declares that the RT install in question is RT 3.8.x. C<rt-apache> can +usually detect this for you, however. + +=item --modules B<path> + +The path to the Apache2 modules directory, which is expected to contain +at least one of F<mod_fcgid.so>, F<mod_fastcgi.so>, or F<mod_perl.so>. +Defaults to F</usr/lib/apache2/modules>. + +=back + +=cut + +__DATA__ +<IfDefine SINGLE> + <IfModule mpm_prefork_module> + StartServers 1 + MinSpareServers 1 + MaxSpareServers 1 + MaxClients 1 + MaxRequestsPerChild 0 + </IfModule> + + <IfModule mpm_worker_module> + StartServers 1 + MinSpareThreads 1 + MaxSpareThreads 1 + ThreadLimit 1 + ThreadsPerChild 1 + MaxClients 1 + MaxRequestsPerChild 0 + </IfModule> +</IfDefine> + +Listen $PORT +<IfDefine SSL> + Listen $SSL +</IfDefine> + +ServerName localhost +ServerRoot $RTHOME/var +PidFile $RTHOME/var/apache2.pid +LockFile $RTHOME/var/apache2.lock +ServerAdmin root@localhost + +LoadModule authz_host_module $MODULES/mod_authz_host.so +LoadModule env_module $MODULES/mod_env.so +LoadModule alias_module $MODULES/mod_alias.so +LoadModule mime_module $MODULES/mod_mime.so +TypesConfig $TOOLS/mime.types + +<IfDefine PERL> + LoadModule perl_module $MODULES/mod_perl.so +</IfDefine> +<IfDefine FASTCGI> + LoadModule fastcgi_module $MODULES/mod_fastcgi.so +</IfDefine> +<IfDefine FCGID> + LoadModule fcgid_module $MODULES/mod_fcgid.so +</IfDefine> +<IfDefine SSL> + LoadModule ssl_module $MODULES/mod_ssl.so +</IfDefine> + +<IfModule !log_config_module> + LoadModule log_config_module $MODULES/mod_log_config.so +</IfModule> +ErrorLog "$RTHOME/var/log/apache-error.log" +TransferLog "$RTHOME/var/log/apache-access.log" +LogLevel notice + +<Directory /> + Options FollowSymLinks + AllowOverride None + Order deny,allow + Deny from all +</Directory> + +AddDefaultCharset UTF-8 + +DocumentRoot $RTHOME/share/html +<Directory $RTHOME/share/html> + Order allow,deny + Allow from all +</Directory> + +Alias $PATH/NoAuth/images/ $RTHOME/share/html/NoAuth/images/ +<Directory $RTHOME/share/html/NoAuth/images> + Order allow,deny + Allow from all +</Directory> + +<IfDefine !RT3> +########## 4.0 mod_perl +<IfDefine PERL> + PerlSetEnv RT_SITE_CONFIG $RTHOME/etc/RT_SiteConfig.pm + <Location $PATH> + Order allow,deny + Allow from all + SetHandler modperl + PerlResponseHandler Plack::Handler::Apache2 + PerlSetVar psgi_app $RTHOME/sbin/rt-server + </Location> + <Perl> + use Plack::Handler::Apache2; + Plack::Handler::Apache2->preload("$RTHOME/sbin/rt-server"); + </Perl> +</IfDefine> + +########## 4.0 mod_fastcgi +<IfDefine FASTCGI> + FastCgiIpcDir $RTHOME/var + FastCgiServer $RTHOME/sbin/rt-server.fcgi -processes $PROCESSES -idle-timeout 300 + ScriptAlias $PATH $RTHOME/sbin/rt-server.fcgi/ + <Location $PATH> + Order allow,deny + Allow from all + Options +ExecCGI + AddHandler fastcgi-script fcgi + </Location> +</IfDefine> + +########## 4.0 mod_fcgid +<IfDefine FCGID> + FcgidProcessTableFile $RTHOME/var/fcgid_shm + FcgidIPCDir $RTHOME/var + FcgidMaxRequestLen 1073741824 + ScriptAlias $PATH $RTHOME/sbin/rt-server.fcgi/ + <Location $PATH> + Order allow,deny + Allow from all + Options +ExecCGI + AddHandler fcgid-script fcgi + </Location> +</IfDefine> +</IfDefine> + + +<IfDefine RT3> +########## 3.8 mod_perl +<IfDefine PERL> + PerlSetEnv RT_SITE_CONFIG $RTHOME/etc/RT_SiteConfig.pm + PerlRequire "$RTHOME/bin/webmux.pl" + <Location $PATH/NoAuth/images> + SetHandler default + </Location> + <Location $PATH> + SetHandler perl-script + PerlResponseHandler RT::Mason + </Location> +</IfDefine> + +########## 3.8 mod_fastcgi +<IfDefine FASTCGI> + FastCgiIpcDir $RTHOME/var + FastCgiServer $RTHOME/bin/mason_handler.fcgi -processes $PROCESSES -idle-timeout 300 + ScriptAlias $PATH $RTHOME/bin/mason_handler.fcgi/ + <Location $PATH> + Order allow,deny + Allow from all + Options +ExecCGI + AddHandler fastcgi-script fcgi + </Location> +</IfDefine> + +########## 3.8 mod_fcgid +<IfDefine FCGID> + FcgidProcessTableFile $RTHOME/var/fcgid_shm + FcgidIPCDir $RTHOME/var + FcgidMaxRequestLen 1073741824 + ScriptAlias $PATH $RTHOME/bin/mason_handler.fcgi/ + <Location $PATH> + Order allow,deny + Allow from all + Options +ExecCGI + AddHandler fcgid-script fcgi + </Location> +</IfDefine> +</IfDefine> + +<IfDefine SSL> + SSLRandomSeed startup builtin + SSLRandomSeed startup file:/dev/urandom 512 + SSLRandomSeed connect builtin + SSLRandomSeed connect file:/dev/urandom 512 + SSLSessionCache shmcb:$RTHOME/var/ssl_scache(512000) + SSLMutex file:$RTHOME/var/ssl_mutex + <VirtualHost *:$SSL> + SSLEngine on + SSLCertificateFile $TOOLS/localhost.crt + SSLCertificateKeyFile $TOOLS/localhost.key + </VirtualHost> +</IfDefine> diff --git a/rt/devel/tools/rt-static-docs b/rt/devel/tools/rt-static-docs new file mode 100644 index 000000000..30d422d04 --- /dev/null +++ b/rt/devel/tools/rt-static-docs @@ -0,0 +1,225 @@ +#!/usr/bin/env perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 Getopt::Long; +use File::Temp; +use File::Spec; +use File::Path qw(make_path rmtree); +use File::Copy qw(copy); +use HTML::Entities qw(encode_entities); +use RT::Pod::HTMLBatch; + +my %opts; +GetOptions( + \%opts, + "help|h", + "rt=s", + "to=s", +); + +if ( $opts{'help'} ) { + require Pod::Usage; + print Pod::Usage::pod2usage( -verbose => 2 ); + exit; +} + +die "--to=DIRECTORY is required\n" unless $opts{to}; + +$opts{to} = File::Spec->rel2abs($opts{to}); + +make_path( $opts{to} ) unless -e $opts{to}; +die "--to MUST be a directory\n" unless -d $opts{to}; + +# Unpack the tarball, if that's what we're given. +my $tmpdir; +if (($opts{rt} || '') =~ /\.tar\.gz$/ and -f $opts{rt}) { + $tmpdir = File::Temp->newdir(); + + system("tar", "xzpf", $opts{rt}, "-C", $tmpdir); + $opts{rt} = <$tmpdir/rt-*>; +} +chdir $opts{rt} if $opts{rt}; + +my @dirs = ( + qw( + docs + etc + lib + bin + sbin + devel/tools + local/lib + local/sbin + local/bin + ), + glob("local/plugins/*/{lib,sbin,bin}"), + glob("docs/UPGRADING*"), +); + +my $converter = RT::Pod::HTMLBatch->new; + +sub generate_configure_help { + my $configure = shift; + my $help = `./$configure --help`; + my $dest = "$opts{to}/configure.html"; + + if ($help and open my $html, ">", $dest) { + print $html join "\n", + "<pre>", encode_entities($help), "</pre>", "\n"; + close $html; + $converter->note_for_contents_file(["configure options"], $configure, $dest); + } else { + warn "Can't open $dest: $!"; + } +} + +# Generate a page for ./configure --help if we can +if (-x "configure.ac" and -d ".git") { + rmtree("autom4te.cache") if -d "autom4te.cache"; + generate_configure_help("configure.ac"); +} +elsif (-x "configure") { + generate_configure_help("configure"); +} +else { + warn "Unable to generate a page for ./configure --help!\n"; +} + +# Manually "convert" README* and 3.8-era UPGRADING* to HTML and push them into +# the known contents. +for my $file (<README* UPGRADING*>) { + (my $name = $file) =~ s{^.+/}{}; + my $dest = "$opts{to}/$name.html"; + + open my $source, "<", $file + or warn "Can't open $file: $!", next; + + open my $html, ">", $dest + or warn "Can't open $dest: $!", next; + + print $html "<pre>"; + print $html encode_entities($_) while <$source>; + print $html "</pre>"; + + close $source; close $html; + + $converter->note_for_contents_file([$name], $file, $dest); +} + +# Copy images into place +make_path("$opts{to}/images/"); +copy($_, "$opts{to}/images/") + for <docs/images/*.{png,jpeg,jpg,gif}>; + +# Temporarily set executable bits on upgrading doc to work around +# Pod::Simple::Search limitation/bug: +# https://rt.cpan.org/Ticket/Display.html?id=80082 +sub system_chmod { + system("chmod", @_) == 0 + or die "Unable to chmod: $! (exit $?)"; +} +system_chmod("+x", $_) for <docs/UPGRADING*>; + +# Convert each POD file to HTML +$converter->batch_convert( \@dirs, $opts{to} ); + +# Remove execution bit from workaround above +system_chmod("-x", $_) for <docs/UPGRADING*>; + +# Need to chdir back out, if we are in the tmpdir, to let it clean up +chdir "/" if $tmpdir; + +exit 0; + +__END__ + +=head1 NAME + +rt-static-docs - generate doc shipped with RT + +=head1 SYNOPSIS + + rt-static-docs --to /path/to/output [--rt /path/to/rt] + +=head1 DESCRIPTION + +RT ships with documentation (written in POD) embedded in library files, at the +end of utility scripts, and in standalone files. This script finds all of that +documentation, collects and converts it into a nice set of HTML files, and tops +it off with a helpful index. + +Best Practical uses this to publish documentation under +L<http://bestpractical.com/rt/docs/>. + +=head1 OPTIONS + +=over + +=item --to + +Set the destination directory for the output files. + +=item --rt + +Set the RT base directory to search under. Defaults to the current working +directory, which is fine if you're running this script as +C<devel/tools/rt-static-docs>. + +May also point to a tarball (a file ending in C<.tar.gz>) which will be +unpacked into a temporary directory and used as the RT base directory. + +=item --help + +Print this help. + +=back + +=cut diff --git a/rt/docs/backups.pod b/rt/docs/backups.pod new file mode 100644 index 000000000..648105c66 --- /dev/null +++ b/rt/docs/backups.pod @@ -0,0 +1,108 @@ +=head1 BACKUPS + +RT is often a critical piece of businesses and organizations. Backups are +absolutely necessary to ensure you can recover quickly from an incident. + +Make sure you take backups. Make sure they I<work>. + +There are many issues that can cause broken backups, such as a +C<max_allowed_packet> too low for MySQL (in either the client or server), or +encoding issues, or running out of disk space. + +Make sure your backup cronjobs notify someone if they fail instead of failing +silently until you need them. + +Test your backups regularly to discover any unknown problems B<before> they +become an issue. You don't want to discover problems with your backups while +tensely restoring from them in a critical data loss situation. + +=head2 DATABASE + +You should backup the entire RT database, although for improved speed and space +you can ignore the I<data> in the C<sessions> table. Make sure you still get +the C<sessions> schema, however. + +Database specific notes and example backup commands for each database are +below. Adjust the commands as necessary for connection details such as +database name (C<rt4> is the placeholder below), user, password, host, etc. +You should put the example commands into a shell script for backup and setup a +cronjob. Make sure output from cron goes to someone who reads mail! (Or into +RT. :) + +=head3 MySQL + + ( mysqldump rt4 --tables sessions --no-data; \ + mysqldump rt4 --ignore-table rt4.sessions --single-transaction ) \ + | gzip > rt-`date +%Y%M%d`.sql.gz + +If you're using a MySQL version older than 4.1.2 (only supported on RT 3.8.x +and older), you should be also pass the C<--default-character-set=binary> +option to the second C<mysqldump> command. + +The dump will be much faster if you can connect to the MySQL server over +localhost. This will use a local socket instead of the network. + +If you find your backups taking far far too long to complete (this point should +take quite a long time to get to on an RT database), there are some alternate +solutions. Percona maintains a highly regarded hot-backup tool for MySQL +called L<XtraBackup|http://www.percona.com/software/percona-xtrabackup/>. If +you have more resources, you can also setup replication to a slave using binary +logs and backup from there as necessary. This not only duplicates the data, +but lets you take backups without putting load on your production server. + +=head3 PostgreSQL + + ( pg_dump rt4 --table=sessions --schema-only; \ + pg_dump rt4 --exclude-table=sessions ) \ + | gzip > rt-`date +%Y%M%d`.sql.gz + +=head2 FILESYSTEM + +You will want to back up, at the very least, the following directories and files: + +=over 4 + +=item /opt/rt4 + +RT's source code, configuration, GPG data, and plugins. Your install location +may be different, of course. + +You can omit F<var/mason_data> and F<var/session_data> if you'd like since +those are temporary caches. Don't omit all of F<var/> however as it may +contain important GPG data. + +=item Webserver configuration + +Often F</etc/httpd> or F</etc/apache2>. This will depend on your OS, web +server, and internal configuration standards. + +=item /etc/aliases + +Your incoming mail aliases mapping addresses to queues. + +=item Mail server configuration + +If you're running an MTA like Postfix, Exim, SendMail, or qmail, you'll want to +backup their configuration files to minimize restore time. "Lightweight" mail +handling programs like fetchmail, msmtp, and ssmtp will also have configuration +files, although usually not as many nor as complex. You'll still want to back +them up. + +The location of these files is highly dependent on what software you're using. + +=item Crontab containing RT's cronjobs + +This may be F</etc/crontab>, F</etc/cron.d/rt>, a user-specific crontab file +(C<crontab -l $USER>), or some other file altogether. Even if you only have +the default cronjobs in place, it's one less piece to forget during a restore. +If you have custom L<< C<rt-crontool> >> invocations, you don't want to have to +recreate those. + +=back + +Simply saving a tarball should be sufficient, with something like: + + tar czvpf rt-backup-`date +%Y%M%d`.tar.gz /opt/rt4 /etc/aliases /etc/httpd ... + +Be sure to include all the directories and files you enumerated above! + diff --git a/rt/docs/customizing/approvals.pod b/rt/docs/customizing/approvals.pod new file mode 100644 index 000000000..af5aa3b0a --- /dev/null +++ b/rt/docs/customizing/approvals.pod @@ -0,0 +1,191 @@ +=head1 RT Approvals + +Some types of change requests processed through RT can +require an approval before being fulfilled. You can configure +RT to set up such an approval workflow for tickets in +queues you select. + +This document walks through the steps to set up a +"Change requests" queue with approvals. You should try +this in a test instance first. If you don't have a test RT +instance, you should read through the entire document first, +change the details as needed for your approval scenario, and then +set up approvals. + +=head2 Overview + +The approvals solution in RT involves using a special queue, +called ___Approvals, to hold approval requests. Scrips and +templates automatically create the necessary tickets +and process the approval or rejection. + +=head2 Change Management Queue + +Since this example will use a change management queue as the +queue where tickets need approval, first we'll set up the queue. + +Login into UI as the 'root' user. Go to Tools -> Configuration -> +Queues and create a new 'Change requests' queue. + +When you set up this queue, do not select the "approvals" Lifecycle. +That selection is for the ___Approvals queue itself, not for queues that +need tickets approved. + +=head3 Change Management Template + +Once the Change Management queue is created, select Templates +-> Create in the queue configuration menu. Enter the Name 'create approval', +leave the default Type as Perl and in the content area enter the following: + + ===Create-Ticket: Manager approval + Subject: Manager Approval for {$Tickets{TOP}->Id} - {$Tickets{TOP}->Subject} + Depended-On-By: TOP + Queue: ___Approvals + Owner: root + Requestors: {$Tickets{TOP}->RequestorAddresses} + Type: approval + Content-Type: text/plain + Due: {time + 3*24*60*60} + Content: Please approve me. + + Thanks. + ENDOFCONTENT + +All of the text should be against the left side of the textarea +with no spaces. + +Click create. + +You'll now use this template when you create the scrip. + +=head3 Change Management Scrip + +Now you need a scrip. On the queue configuration page, select +Scrips -> Create. For the Description, enter 'Create an approval +on ticket create', select the 'On Create' condition, 'Create Tickets' +action, and select the template you just created. Click create. + +=head3 Testing + +You can already test your first workflow with approvals. Create +a ticket in your new 'Change requests' queue. You're logged in as +'root' and the owner of the approval is root (based on the template), +so it's your job to approve or deny the request. Select Tools -> Approvals +in the RT main menu. You should see your first approval request. + +Select the 'Deny' radio button, write 'too expensive' in the notes area +and click Go! You just rejected the approval request. If you open the ticket +you created for testing then you will see that it's rejected +as well and has the correspondence: + + Greetings, + + Your ticket has been rejected by root. + + Approver's notes: too expensive + +You may need to search for the ticket since the rejected state means +it's no longer 'active'. + +Where did this message come from? From templates in the ___Approvals +queue. + +=head2 ___Approvals queue + +___Approvals is a special queue where all approvals are created. The queue +is disabled and is not shown in until you search for it. +Go to Tools -> Configuration -> Queues, leave "Name is" in the search +area and enter ___Approvals into the search +field. Check 'Include disabled queues in listing.' and click Go! +You should now see the ___Approvals queue configuration page. + +You may want to change the name of the ___Approvals queue, but parts of RT +expect it not to change. The name normally isn't shown to users, however, so +it will be largely invisible. + +=head2 Approvals' templates + +From the ___Approvals queue configuration page, click 'Templates' in the +page menu. You should see templates that are used after actions +on approvals. For example if you click on the 'Approval Rejected' +template in the list, you will see the template that generates +the correspondence mentioned above. + +=over 4 + +=item * New Pending Approval + +Owners of new approval requests get this message. + +=item * Approval Passed + +Recorded as correspondence on the ticket when it's approved by an +approver, but still requires more people to approve. + +=item * All Approvals Passed + +Recorded when no more approvals are required. + +=item * Approval Rejected + +Recorded when the approval request is rejected (denied). + +=item * Approval Ready for Owner + +Sent to the Owner of the ticket when it's approved and no more approvals +are required. + +=back + +You can customize these templates to meet your needs. However, +note that there is just one ___Approvals queue for the system, +so make sure changes work with all queues that use approvals. + +=head2 Approvers + +Navigate back to the template used to create approvals. It has +the following line: + + Owner: root + +With this code you set the owner of the approval request to root. +Approvals, as well as tickets, have Ccs, AdminCcs and Requestors. For +example the following line copies requestors from the Tickets +to the approval request: + + Requestors: {$Tickets{TOP}->RequestorAddresses} + +Let's create a group 'Change Approvers' and let any user of +this group approve 'Change Requests'. Create the group, and add root +as a member. Open the 'create an approval' template, and replace +the 'Owner:...' line with the following: + + AdminCcGroup: Change Approvers + +Note that this line only works in RT 4.0.5 and newer. + +Create another test ticket, and you as root still should be able to see +the newly created approval, but now because of the group membership. +You can accept or deny it. + +Any member of the group can accept/deny without consulting +the other members, which is useful with more complex +multistep workflows. + +=head2 Approvers' Rights + +Since the ___Approvals queue is a regular RT queue, you need +to grant rights to allow your approvers to operate on approval +requests. As root, you have super user rights and haven't needed +specific rights for this example. + +It's wise to grant rights via roles as there +is only one queue for all approvals in the system. + +To grant rights to your Change Approvers group, go to the queue +configuration page for the ___Approvals queue. Click on Group Rights +in the page menu. Grant ShowTicket and ModifyTicket rights to the +Owner and AdminCc roles. This should be enough for most cases. + +Now members of the 'Change Approvers' group can act on approvals +even if they have no SuperUser rights. diff --git a/rt/docs/customizing/lifecycles.pod b/rt/docs/customizing/lifecycles.pod new file mode 100644 index 000000000..76e60003a --- /dev/null +++ b/rt/docs/customizing/lifecycles.pod @@ -0,0 +1,478 @@ +=head1 Ticket Lifecycles + +By default, RT comes with ticket statuses that work for many types +of workflows: new, open, stalled, resolved, rejected, and deleted. +But there can be any number of workflows where these status values +don't completely fit. RT allows you to add new custom status values and +define their behavior with a feature called Lifecycles. + +=head1 Adding a New Status + +Because Statuses are controlled via lifecycles, you must manipulate the entire +lifecycle configuration to add a status. In earlier versions of RT new statuses +could be added by adding a new element to an array in RT's config file. But +because lifecyles are built around statuses, the entire lifecycle configuration +must be modified even if you only need new statuses. + +=head2 Copy Lifecycle Config + +First, copy the C<%Lifecycles> hash from C<RT_Config.pm> and paste it into +C<RT_SiteConfig.pm>. + +=head2 Add Status Value + +Add the status to the set where your new status belongs. This example adds +C<approved> to the active statuses: + + active => [ 'open', 'approved', 'stalled' ], + +=head2 Update Transitions + +Now the transitions section must be updated so that the new status can +transition to the existing statuses and also so the existing statuses can +transition to the new status. + + new => [qw( open approved stalled resolved rejected deleted)], + open => [qw(new approved stalled resolved rejected deleted)], + approved => [qw(new open stalled resolved rejected deleted)], + stalled => [qw(new open approved rejected resolved deleted)], + resolved => [qw(new open approved stalled rejected deleted)], + rejected => [qw(new open approved stalled resolved deleted)], + deleted => [qw(new open approved stalled rejected resolved )], + +=head1 Order Processing Example + +This guide demonstrates lifecycles using an order fulfillment +system as a real-world example. You can find full lifecycles +documentation in L<RT_Config/Lifecycles>. + +As with all RT custom configuration, if you are customizing the RT +lifecycle, make your changes in your C<RT_SiteConfig.pm> file, not +directly in C<RT_Config.pm>. If you are adding a new lifecycle, you can +add a new entry with: + + Set(%Lifecycles, my_new_lifecycle => { ... } ); + +The detailed configuration options are discussed below. Once you add it +and restart the server, the new lifecycle will be available on the +queue configuration page. + +To show how you might use custom lifecycles, we're going to configure +an RT lifecycle to process orders of some sort. In our order example, +each ticket in the queue is considered a separate order and the orders +have the following statuses: + +=over + +=item pending + +The order just came in untouched, pending purchase validation + +=item processing + +The order is being looked at for transaction processing + +=item delivery + +The order is out for delivery + +=item delivered + +The order was successfully delivered to its destination + +=item refunded + +The order was delivered but subsequently refunded + +=item declined + +There was an error in the process validation and the order was denied purchase + +=back + +In this particular example, the only status an order can start with is +'pending.' When a process coordinator chooses to take this order, it +goes into processing. The order can then either be delivered or denied +processing. Once denied, the lifecycle for that order ends. If it is +delivered, the order can still be refunded. + +The following sections walk through each part of the configuration. +You can find the full configuration at the end in case you want to +see the exact syntax or use it to experiment with. + +=head2 Defining Status Values + +Every queue has a lifecycle assigned to it. Without changing any +configuration, you are given two lifecycles to choose from: "default" +and "approvals." The approvals lifecycle is used by the internal +approvals queue, and should not be changed or used by other queues. Do +not modify the approvals lifecycle unless you fully understand how RT +approvals work. + +=for html <img alt="Lifecycle choices" src="../images/lifecycle-choices.png"> + +=for :text [Lifecycle choices F<docs/images/lifecycle-choices.png>] + +=for :man [Lifecycle choices F<docs/images/lifecycle-choices.png>] + +In RT 4.0, the C<@ActiveStatus> and C<@InactiveStatus> configurations +which were previously available are gone. The logic defined by those +options is now a subset of RT's lifecycle features, as described here. + +A ticket naturally has three states: initial (I<new>), active (I<open> and +I<stalled>), and inactive (I<resolved>, I<rejected>, and I<deleted>). These +default settings look like this in the C<RT_Config.pm> file: + + default => { + initial => [ 'new' ], + active => [ 'open', 'stalled' ], + inactive => [ 'resolved', 'rejected', 'deleted' ], + +The initial state is the default starting place for new tickets, although +you can create tickets with other statuses. Initial is generally used +to acknowledge that a request has been made, but not yet acted on. RT +sets the Started date on a ticket when it is moved out of the initial state. + +Active tickets are currently being worked on, inactive tickets have reached +some final state. By default, inactive tickets don't show up in search +results. The AutoOpen action sets a ticket's status to the first active +status. You can find more details in L<RT_Config/"Lifecycle definitions">. + +Now we want to set up some statuses appropriate for order fulfillment, +so we create a new top-level key called C<orders> and add our new status +values. + + Set( %Lifecycles, orders => { + initial => [ 'pending' ], + active => [ 'processing', 'delivery' ], + inactive => [ 'delivered', 'returned', 'declined', 'deleted' ], + # ..., + }); + +We still use the initial, active and inactive categories, but we are +able to define status values that are appropriate for the workflow +we want to create. This should make the system more intuitive for users. + +=head2 Transitions + +The typical lifecycle follows the path initial -> active -> inactive. +Obviously the path of a ticket can get more complicated than this, which +is where transitions come into play. + +Transitions manage the flow of a ticket from status to status. This +section of the configuration has keys, which are the current status, +and values that define which other statuses the ticket can transition +to. Here are the transitions we define for our order process. + + Set( %Lifecycles, orders => { + # ..., + transitions => { + '' => [qw(pending processing declined)], + pending => [qw(processing declined deleted)], + processing => [qw(pending declined delivery delivered deleted)], + delivery => [qw(pending delivered returned deleted)], + delivered => [qw(pending returned deleted)], + returned => [qw(pending delivery deleted)], + deleted => [qw(pending processing delivered delivery returned)], + }, + # ..., + }); + +If a ticket is in the delivered status, it doesn't make sense for it to +transition to processing or declined since the customer already has the +order. However, it can transition to returned since they could send it back. +The configuration above defines this for RT. + +The C<''> entry defines the valid statuses when a ticket is created. + +Deleted is a special status in RT that allows you to remove a ticket from +active use. You may need to do this if a ticket is created by mistake, or +a duplicate is created. Once deleted, a ticket will never show up in search +results. As you can see, the system will allow you to +transition to deleted from any status. + +=head2 Rights and Access Control + +Your workflow may have several people working on tickets at different +steps, and for some you may want to make sure only certain users +can perform certain actions. For example, the company may have a rule +that only the quality assurance team is allowed to approve (or decline) +an order for delivery. + +You can apply labels to transitions and assign rights to them to allow +you to apply this sort of access control. This is done with a rights +entry: + + Set( %Lifecycles, orders => { + # ..., + rights => { + '* -> declined' => 'DeclineOrder', + '* -> delivery' => 'ApproveOrder', + }, + # ..., + }); + +This configuration tells RT to require the right DeclineOrder for a +transition from any status (C<*>) to C<declined>. The ApproveOrder +right is similar, but for C<delivery>. These rights take the place of +the standard ModifyTicket right, not in addition to it, so keep that +in mind when creating and assigning new rights. + +Once these rights are configured and loaded (by restarting the web +server), they can be assigned in the web UI to groups, queues, and users. +The rights show up on the rights pages in a Status tab alongside the +standard RT rights tabs. + +=for html <img alt="Lifecycle group rights" src="../images/global-lifecycle-group-rights.png"> + +=for :text [Lifecycle group rights F<docs/images/global-lifecycle-group-rights.png>] + +=for :man [Lifecycle group rights F<docs/images/global-lifecycle-group-rights.png>] + +After a status transition right is granted, users with the right will see +the status in the drop-down, and possibly any related actions (see +L</Actions>). + +=head2 Default Status + +There are interfaces to RT from which it isn't possible to define a status, +like sending an email to create a ticket, but tickets +require a status. To handle these cases, you can set +default status values for RT to use when the user doesn't explicitly set +a value. + +Looking at the defaults section in the standard RT configuration, +you can see the events for which you can define a default status. +For example, 'on_create' => 'new' automatically gives newly created tickets +a C<new> status when the requestor doesn't supply a status. We can do the same +for our process. + + Set( %Lifecycles, orders => { + defaults => { + on_create => 'pending', + }, + # ..., + }); + +Only a small number of defaults are needed because in practice there are +relatively few cases where a ticket will find itself without a status or +in an ambiguous state. + +=head2 Actions + +To customize how transitions are presented in RT, lifecycles have an +C<actions> section where you can customize how an action (e.g. changing +status from new -> open) looks and functions. You can customize the action's +label, which is how it appears to users, and the type of update, either comment +or reply. As an example, in the default RT configuration the action +"new -> open" has the default label "Open it" and an update value of C<Respond>. + +Using the lifecycles configuration, you can change the label to anything you +like. You can set the update option to C<Comment> or C<Respond>, which tells RT +to process the action as a comment (not sent to requestors) or a reply (sent +to requestors). + +This part of the lifecycles configuration replaces the previous +C<$ResolveDefaultUpdateType> configuration value. To mimic that option, set +the update type to C<Comment> for all transitions to C<resolved>. + +Here is an example of a change we might make for our order process: + + Set( %Lifecycles, orders => { + # ..., + actions => [ + 'pending -> processing' => { + label => 'Open For Processing', + update => 'Comment', + }, + 'pending -> declined' => { + label => 'Decline', + update => 'Respond', + }, + # ... + ], + # ... + }); + +Alternatively, supplying no update type results in a "quick" +action that changes the status immediately without going through the +ticket update page. RT's default "Delete" action is a "quick" action, +for example: + + # from the RT "default" lifecycle + 'new -> deleted' => { + label => 'Delete', + }, + +If the transition has an associated right, it must be granted for a user to +see the action. For example, if we give a group the DeclineOrder right as +shown in the earlier example, members of that group will see a Decline option +in their Actions menu if a ticket has a pending status. The +L</"Full Configuration"> at the end shows other action entries that +make the Decline option available in more cases. + +=for html <img alt="Action menu decline" src="../images/action-decline.png"> + +=for :text [Action menu decline F<docs/images/action-decline.png>] + +=for :man [Action menu decline F<docs/images/action-decline.png>] + +=head2 Mapping Between Queues + +As we've demonstrated, each queue can have its own custom lifecycle, but +in RT you sometimes want to move a ticket from one queue to another. +A ticket will have a status in a given queue, but that status may not +exist in another queue you want to move the ticket to, or it may exist +but mean something different. To allow tickets to move between queues with +different lifecycles, RT needs to know how to set the status appropriately. + +The lifecycle configuration has a C<__maps__> entry to allow you to +specify the mappings you want between different queues. Sometimes statuses +between queues don't or can't match perfectly, but if you need to move +tickets between those queues, it's important that you provide a complete +mapping, defining the most sensible mapping you can. + +If you don't provide a mapping, users will see an error when they try to +move a ticket between queues with different lifecycles but no mapping. + + Set( %Lifecycles, orders => { + # ..., + __maps__ => { + 'default -> orders' => { + 'new' => 'pending', + 'open' => 'processing', + # ..., + }, + 'orders -> default' => { + 'pending' => 'new', + 'processing' => 'open', + # ..., + }, + # ..., + }, + # ..., + }); + +In the example above, we first define mappings between the default queue and +our new orders queue. The second block defines the reverse for tickets that +might be moved from the orders queue to a queue that uses the default lifecycle. + +=head2 Full Configuration + +Here is the full configuration if you want to add it to your RT instance +to experiment. + + Set(%Lifecycles, + + # 'orders' shows up as a lifecycle choice when you create a new + # queue or modify an existing one + orders => { + # All the appropriate order statuses + initial => [ 'pending' ], + active => [ 'processing', 'delivery' ], + inactive => [ 'delivered', 'returned', 'declined' ], + + # Default order statuses for certain actions + defaults => { + on_create => 'pending', + }, + + # Status change restrictions + transitions => { + '' => [qw(pending processing declined)], + pending => [qw(processing declined deleted)], + processing => [qw(pending declined delivery delivered deleted)], + delivery => [qw(pending delivered returned deleted)], + delivered => [qw(pending returned deleted)], + returned => [qw(pending delivery deleted)], + deleted => [qw(pending processing delivered delivery returned)], + }, + + # Rights for different actions + rights => { + + # These rights are in the default lifecycle + '* -> deleted' => 'DeleteTicket', + '* -> *' => 'ModifyTicket', + + # Maybe we want to create rights to keep QA rigid + '* -> declined' => 'DeclineOrder', + '* -> delivery' => 'ApproveOrder', + }, + + # Actions for the web UI + actions => [ + 'pending -> processing' => { + label => 'Open For Processing', + update => 'Comment', + }, + 'pending -> delivered' => { + label => 'Mark as being delivered', + update => 'Comment', + }, + 'pending -> declined' => { + label => 'Decline', + update => 'Respond', + }, + 'pending -> deleted' => { + label => 'Delete', + }, + 'processing -> declined' => { + label => 'Decline', + update => 'Respond', + }, + 'processing -> delivery' => { + label => 'Out for delivery', + update => 'Comment', + }, + 'delivery -> delivered' => { + label => 'Mark as delivered', + update => 'Comment', + }, + 'delivery -> returned' => { + label => 'Returned to Manufacturer', + update => 'Respond', + }, + 'delivered -> returned' => { + label => 'Returned to Manufacturer', + update => 'Respond', + }, + 'returned -> delivery' => { + label => 'Re-deliver Order', + update => 'Respond', + }, + 'deleted -> pending' => { + label => 'Undelete', + update => 'Respond', + }, + ], + }, + + # Status mapping different different lifecycles + __maps__ => { + 'default -> orders' => { + 'new' => 'pending', + 'open' => 'processing', + 'stalled' => 'processing', + 'resolved' => 'delivered', + 'rejected' => 'declined', + 'deleted' => 'deleted', + }, + 'orders -> default' => { + 'pending' => 'new', + 'processing' => 'open', + 'delivered' => 'resolved', + 'returned' => 'open', # closest matching we have in 'default' + 'declined' => 'rejected', + 'deleted' => 'deleted', + }, + }, + ); + +Here is an example history of a ticket following this lifecycle: + +=for html <img alt="Lifecycle history" src="../images/order-history-example.png"> + +=for :text [Lifecycle history F<docs/images/order-history-example.png>] + +=for :man [Lifecycle history F<docs/images/order-history-example.png>] diff --git a/rt/docs/customizing/search_result_columns.pod b/rt/docs/customizing/search_result_columns.pod new file mode 100644 index 000000000..7eef416a7 --- /dev/null +++ b/rt/docs/customizing/search_result_columns.pod @@ -0,0 +1,180 @@ +=head1 RT Search Results + +Ticket search results in RT are presented as a table with multiple heading +rows, one for each element of ticket metadata you have selected. Each +row in the table represents one ticket and the appropriate metadata is +displayed in each column. You can see similar listings when you search +for other objects in RT like users, queues, templates, etc. + +For tickets, the Query Builder allows you to modify the column layout using +the Sorting and Display Columns sections at the bottom of the page. With +them you can add and remove data elements to sort by, change the sort order, +and add and remove which columns you want to see. + +Although the Add Columns box has an extensive list of available columns, there +are times when you need a value not listed. Sometimes what you want is a +value calculated based on existing ticket values, like finding the difference +between two date fields. RT provides a way to add this sort of customization +using something called a Column Map. + +=head2 Level of Difficulty + +The customizations described in this section require administrative access +to the RT server and the RT filesystem, typically root or sudo level access. +The customizations involve adding new code to RT, which is written in the +L<Perl|http://www.perl.org/> programming language and uses the +L<Mason|http://www.masonbook.com/> templating system. If you follow the example +closely, you should be able to set up simple column maps with a basic +understanding of these. For more complicated configurations, you may need +to do more research to understand the Perl and Mason syntax. + +=head2 Column Maps + +Each column in a ticket listing gets run through a bit of code called a +Column Map that allows you to perform transformations on the value before +it is displayed. In some cases, the value is just passed through. In others, +like DueRelative, a date is transformed to a relative time like "2 days ago." +You can tap into this functionality to add your own transformations or even +generate completely new values. + +To add to the existing Column Maps, you can use RT's callback +mechanism. This allows you to add code to RT without modifying the core files, +making upgrades much easier. As an example, we'll add a Column Map to the +ticket display and explain the necessary callbacks. You can read more about +callbacks in general in the L<writing_extensions/Callbacks> documentation. + +For our example, let's assume we want to display a response time column that +shows the difference between when a ticket is created and when someone +starts working on it (started date). The two initial values are already +available on the ticket, but it would be convenient to display the +calculated value in our search. + +=head2 Column Map Callback + +First we need to determine where to put our callback. RT's core Column Map code +for tickets is here: + + share/html/Elements/RT__Ticket/ColumnMap + +We'll look there first, both to see some sample Column Maps and also to look +for an appropriate callback to use to add our own. Looking in that file, +we see C<$COLUMN_MAP>, which is a large hashref with entries for each of the +items you see in the Add Columns section of the Query Builder. That's where +we need to add our new Column Map. + +Looking in the C<init> section, we find a callback with a C<CallbackName> +"Once" and it passes the C<$COLUMN_MAP> reference as an argument, so that's +the callback we need. + +Following the callback documentation, we determine we can put our callback +here: + + local/html/Callbacks/MyRT/Elements/RT__Ticket/ColumnMap/Once + +where F<Once> is the name of the file where we'll put our code. + +In the F<Once> file, we'll put the following code: + + <%init> + $COLUMN_MAP->{'TimeToFirstResponse'} = { + title => 'First Response', # loc + attribute => 'First Response', + value => sub { + my $ticket = shift; + return $ticket->StartedObj->DiffAsString($ticket->CreatedObj); + } + }; + </%init> + <%args> + $COLUMN_MAP + </%args> + +Starting with the C<args> section, the value we're interested in is +the C<$COLUMN_MAP> hash reference. Since it's a reference, it's pointing +to the actual data structure constructed in the core RT code. This means +we can add more entries and RT will have access to them. + +=head2 Column Map Parameters + +As you can see in the examples in the core F<ColumnMap> file, each entry +has a key and a hashref with several other parameters. The key needs to be a +unique value. If you using an existing value, you'll overwrite the original +values. + +The parameters in the hashref are as follows: + +=over + +=item title + +The title is what will be used in the header row to identify this value. +The C<# loc> is some special markup that allows RT to replace the value +with translations in other languages, if they are available. + +=item attribute + +This defines the value you can use to reference your new column map +from an RT Format configuration. You can edit formats in the Query +Builder's Advanced section. If you're not familiar with formats, it's +usually safe to set the attribute to the same value as C<title>. It should +be descriptive and unique. + +=item value + +This is where you can put code to transform or calculate the value that +will be displayed. This sets the value you see in the search results +for this column. + +=back + +=cut + +Each of these can be a value like a simple string or an anonymous +subroutine with code that runs to calculate the value. + +If you write a subroutine, as we do for C<value> in our example, RT will +pass the current object as the first parameter to the sub. Since +we're creating a column map for tickets, as RT processes the ticket for +each row in the search results, the ticket object for that ticket is made +available as the first parameter to our subroutine. + +This allows us to then call methods on the L<RT::Ticket> object to access +and process the value. In our case, we can get the L<RT::Date> objects for +the two dates and use the L<RT::Date/DiffAsString> method to calculate and +return the difference. + +When writing code to calculate values, remember that it will be run for each +row in search results. You should avoid doing things that are too time +intensive in that code, like calling a web service to fetch a value. + +=head2 Adding to Display Columns + +Now that we have our column map created, there is one more callback to add +to make it available for all of our users in the Add Columns section in +the Query Builder. This file builds the list of fields available: + + share/html/Search/Elements/BuildFormatString + +Looking there, we see the default callback (the callback without an +explicit C<CallbackName>) passes the C<@fields> array, so that will work. +Create the file: + + local/html/Callbacks/MyRT/Search/Elements/BuildFormatString/Default + +And put the following code in the F<Default> file: + + <%INIT> + push @{$Fields}, 'TimeToFirstResponse'; + </%INIT> + <%ARGS> + $Fields => undef + </%ARGS> + +This puts the hash key we chose for our column map in the fields list so it +will be available in the list of available fields. + +=head2 Last Steps + +Once you have the code in place, stop the RT web server, clear the Mason +cache, and restart the server. Watch the RT logs for any errors, and +navigate to the Query Build to use your new column map. diff --git a/rt/docs/customizing/styling_rt.pod b/rt/docs/customizing/styling_rt.pod new file mode 100644 index 000000000..c5802a84b --- /dev/null +++ b/rt/docs/customizing/styling_rt.pod @@ -0,0 +1,169 @@ +=head1 Customizing the Look of Your RT + +While the default RT color scheme nicely matches the Best Practical colors, +you may want to personalize your RT instance to make it better fit with +your company colors. + + +=head1 Selecting a Theme + +The fundamental look of RT comes from the selected theme. Different +RT versions have a default, and the RT admin can set the system-wide +theme with the C<$WebDefaultStylesheet> configuration value in the +F<RT_SiteConfig.pm> file. + +RT 4.0 comes with the following themes: + +=over + +=item web2 + +An approximation of the 3.8 style + +=item aileron + +The default layout for RT 4.0 + +=item ballard + +Theme which doesn't rely on JavaScript for menuing + +=back + +If you have granted the ModifySelf right to users on your system, +they can pick a different theme for themselves by going to +Logged in as -> Settings -> Options and selecting a different theme. + + +=head1 RT Theme Editor + +RT has some built-in controls to manage the look of the theme you select. +To use the Theme Editor, log in as a SuperUser (like root), and navigate +to Tools -> Configuration -> Tools -> Theme. + +=for html <img alt="RT theme editor, defaults" src="../images/theme_editor_defaults.png"> + +=for :text [RT theme editor image at F<docs/images/theme_editor_defaults.png>] + +=for :man [RT theme editor image at F<docs/images/theme_editor_defaults.png>] + +=head2 Logo and Colors + +From there you can upload a logo and pick colors for the various page +sections. RT will automatically pick out the six most frequent primary +colors from your logo and offer them as options next to the color wheel. +In less than a minute, you can upload a logo and set a few colors. + +Until you click "Save", color changes are temporary and are only shown +to you. When you find the color scheme you want, click Save to make it +the new theme for the entire RT instance. If you ever want to wipe the +slate clean, you can use one or both of the "Reset to default" buttons. + +=head2 Basic CSS Customization + +The theme editor lets you do a bit more if you know your way around CSS +or have a web designer who does. By writing your own styles in the +Custom CSS box, you can quickly customize the RT look and feel pretty +extensively. The primary RT elements are stubbed out for you in the +edit box. + +After making CSS changes, click Try to see how they look, and click Save +when you're done. + + +=head1 Advanced CSS Customization + +If you're more ambitious and good at CSS, you can go even further and +create your own theme. As with all modifications to RT, it's a bad idea +to just change the CSS for one of the standard RT themes in place. When +you upgrade, if you protect your modifications from being over-written, +you may miss out on updates that are required for new features. In the +worst case, an upgrade might wipe out all of your changes. + +Below are a few approaches to customizing RT's CSS. + +=head2 Additional files + +RT allows you to conveniently include additional CSS files after the +default CSS styles, via the C<@CSSFiles> configuration option. To add +an extra CSS file, for example F<my-site.css>, create the local overlay +directory: + + $ mkdir -p local/html/NoAuth/css/ + +And place your F<my-site.css> file in it. Finally, adjust your +C<@CSSFiles> in your F<RT_SiteConfig.pm>: + + Set( @CSSFiles, ('my-site.css') ); + +This technique is preferred to callbacks (below) because CSS included +via this way will be minified. It is also included across all styles, +unlike the callback technique. + +If you are writing an extension, see L<RT/AddStyleSheets> for how to +simply and programmatically add values to C<@CSSFiles>. + +=head2 Callbacks + +RT's CSS files are also Mason templates and the main CSS file, +conveniently called C<main.css>, has a C<Begin> and C<End> callback +allowing you to inject custom CSS. + +To create an End callback, create the callback directory and an +End file in that directory: + + $ mkdir -p local/html/Callbacks/MyRT/NoAuth/css/aileron/main.css + $ touch local/html/Callbacks/MyRT/NoAuth/css/aileron/main.css/End + +You can use any name you want for the C<MyRT> directory and the theme +directory should correspond with the theme you want to change. + +RT will now evaluate the contents of that file after it processes all +of the C<@import> statements in C<main.css>. + + +=head1 Designing Your Own Theme + +The above approaches work well if you need to change the look of +part of RT, but you may want to design your own RT theme +and leave the standard RT themes available to users unmodified. In +this case, you'll want to create your own CSS directory. + +As shown above, the C<local> directory is the place to put +local modifications to RT. Run the following commands in your +C</opt/rt4> directory (or wherever your RT is installed) to get +started: + + $ mkdir -p local/html/NoAuth/css/localstyle + $ cp -R share/html/NoAuth/css/aileron/* local/html/NoAuth/css/localstyle/ + +You can call your "localstyle" directory whatever you want and you don't +have to copy the aileron theme to start from, but it's a good place to +start off for RT4. + +Now set C<$WebDefaultStylesheet> in RT_SiteConfig.pm to the new directory +name you selected, for example: + + Set( $WebDefaultStylesheet, 'localstyle' ); + +If you restart your RT it should look just the same (assuming you copied +your current default theme), but if you go to your Options page you'll +see that the system default theme is now your new "localtheme." + +If you look at the CSS being loaded, you'll also see that the main css +file is now being loaded from your local directory. But you'll also see +that files are still being loaded from the main RT css directories as +well. Why? + +The place to start understanding the loading order of RT's CSS is the +C<main.css> file. You'll see it first loads C<..base/main.css> which +are the base styles for RT along with styles for other tools RT uses +like jQuery. After loading all of the base styles, C<main.css> then +imports a theme-specific version with overrides and new style elements +for the selected theme. So as long as you follow the CSS precedence rules +and use the correct specificity, you get the last chance to modify things. + +You can start modifying things by editing the CSS files in your new +localstyle directory. When you upgrade RT, you'll want to look specifically +at any changes to the style you started from to see if there are any new +styles you want to merge into your new style. diff --git a/rt/docs/initialdata.pod b/rt/docs/initialdata.pod new file mode 100644 index 000000000..6445fb0cd --- /dev/null +++ b/rt/docs/initialdata.pod @@ -0,0 +1,486 @@ +=head1 Summary of initialdata files + +It's often useful to be able to test configuration/database changes and then +apply the same changes in production without manually clicking around. It's +also helpful if you're developing customizations or extensions to be able to +get a fresh database back to the state you want for testing/development. + +This documentation applies to careful and thorough sysadmins as well as +extension authors who need to make database changes easily and repeatably for +new installs or upgrades. + +=head1 Examples + +RT ships with many initialdata files, only one of which is used to +configure a fresh install; the rest are used for upgrades, but function +the same despite being named differently. + + etc/initialdata + etc/upgrade/*/content + +The upgrade "content" files are meant to be incremental changes applied on top +of one another while the top level initialdata file is for fresh RT installs. + +Extensions may also ship with database changes in such files. You may find +some in your install with: + + find local/plugins -name initialdata -or -name content + +=head1 What can be in an initialdata file? + +initialdata files are Perl, but often consist primarily of a bunch of data +structures defining the new records you want and not much extra code. There's +nothing stopping you from writing a bunch of code, however! + +The basic template of a new initialdata file should look something like this: + + use strict; + use warnings; + + our @Queues = ( + # some definitions here + ); + + our @Groups = ( + # some other definitions here + ); + + 1; + +The C<@Queues> and C<@Groups> arrays are expected by RT and should contain +hashref definitions. There are many other arrays RT will look for and act on, +described below. None are required, all may be used. Keep in mind that since +they're just normal Perl arrays, you can C<push> onto them from a loop or +C<grep> out definitions based on conditionals or generate their content with +C<map>, etc. + +The complete list of possible arrays which can be used, along with +descriptions of the values to place in them, is below. + +=head2 C<@Users> + + push @Users, { + Name => 'john.doe', + Password => 'changethis', + Language => 'fr', + Timezone => 'America/Vancouver', + Privileged => 1, + Disabled => 0, + }; + +Each hashref in C<@Users> is treated as a new user to create and passed +straight into C<< RT::User->Create >>. All of the normal user fields are +available, as well as C<Privileged> and C<Disabled> (both booleans) which will +do the appropriate internal group/flag handling. + +For a full list of fields, read the documentation for L<RT::User/Create>. + +=head2 C<@Groups> + + push @Groups, { + Domain => 'UserDefined', + Name => 'Example Employees', + Description => 'All of the employees of my company', + }; + +Creates a new L<RT::Group> for each hashref. In almost all cases you'll want +to follow the example above to create a group just as if you had done it from +the admin interface. B<Do not> omit the C<< Domain => 'UserDefined' >> line. + +Additionally, the C<MemberOf> field is specially handled to make it easier to +add the new group to other groups. C<MemberOf> may be a single value or an +array ref. Each value should be a user-defined group name or hashref to pass +into L<< RT::Group->LoadByCols >>. Each group found will have the new group +added as a member. + +Unfortunately you can't specify the I<members> of a group at this time. As a +workaround, you can push a subref into C<@Final> which adds members to your new +groups. An example, using a convenience function to avoid repeating yourself: + + push @Final, sub { + add_members('My New Group Name' => qw(trs alex ruslan)); + add_members('My Second Group' => qw(jesse kevin sunnavy jim)); + }; + + sub add_members { + my $group_name = shift; + my @members = @_; + + my $group = RT::Group->new( RT->SystemUser ); + $group->LoadUserDefinedGroup($group_name); + + if ($group->id) { + for my $name (@members) { + my $member = RT::User->new( RT->SystemUser ); + $member->LoadByCols( Name => $name ); + + unless ($member->Id) { + RT->Logger->error("Unable to find user '$name'"); + next; + } + + my ($ok, $msg) = $group->AddMember( $member->PrincipalObj->Id ); + if ($ok) { + RT->Logger->info("Added member $name to $group_name"); + } else { + RT->Logger->error("Unable to AddMember $name to $group_name: $msg"); + } + } + } else { + RT->Logger->error("Unable to find group '$group_name'!"); + } + } + +=head2 C<@Queues> + + push @Queues, { + Name => 'Helpdesk', + CorrespondAddress => 'help@example.com', + CommentAddress => 'help-comment@example.com', + }; + +Creates a new L<RT::Queue> for each hashref. Refer to the documentation of +L<RT::Queue/Create> for the fields you can use. + +=head2 C<@CustomFields> + + push @CustomFields, { + Queue => 0, + Name => 'Favorite color', + Type => 'FreeformSingle', + LookupType => 'RT::Queue-RT::Ticket', + }; + +Creates a new L<RT::CustomField> for each hashref. It is the most complex of +the initialdata structures. The most commonly used fields are: + +=over 4 + +=item C<Name> + +The name of this CF as displayed in RT. + +=item C<Description> + +A short summary of what this CF is for. + +=item C<Queue> + +May be a Name or ID. The single queue or array ref of queues to apply this CF +to. This does not apply when C<LookupType> does not start with C<RT::Queue>. + +=item C<Type> + +One of the following on the left hand side: + + SelectSingle # Select one value + SelectMultiple # Select multiple values + + FreeformSingle # Enter one value + FreeformMultiple # Enter multiple values + + Text # Fill in one text area + Wikitext # Fill in one wikitext area + + BinarySingle # Upload one file + BinaryMultiple # Upload multiple files + + ImageSingle # Upload one image + ImageMultiple # Upload multiple images + + Combobox # Combobox: Select or enter one value + + AutocompleteSingle # Enter one value with autocompletion + AutocompleteMultiple # Enter multiple values with autocompletion + + Date # Select date + DateTime # Select datetime + + IPAddressSingle # Enter one IP address + IPAddressMultiple # Enter multiple IP addresses + + IPAddressRangeSingle # Enter one IP address range + IPAddressRangeMultiple # Enter multiple IP address ranges + +If you don't specify "Single" or "Multiple" in the type, you must specify +C<MaxValues>. + +=item C<LookupType> + +Labeled in the CF admin page as "Applies to". This determines whether your CF +is for Tickets, Transactions, Users, Groups, or Queues. Possible values: + + RT::Queue-RT::Ticket # Tickets + RT::Queue-RT::Ticket-RT::Transaction # Transactions + RT::User # Users + RT::Group # Groups + RT::Queue # Queues + +Ticket CFs are the most common, meaning C<RT::Queue-RT::Ticket> is the most +common C<LookupType>. + +=item C<RenderType> + +Only valid when C<Type> is "Select". Controls how the CF is displayed when +editing it. Valid values are: C<Select box>, C<List>, and C<Dropdown>. + +C<List> is either a list of radio buttons or a list of checkboxes depending on +C<MaxValues>. + +=item C<MaxValues> + +Determines whether this CF is a Single or Multiple type. 0 means multiple. 1 +means single. + +Make sure to set the C<MaxValues> field appropriately, otherwise you can end up +with unsupported CF types like a "Select multiple dates" (it doesn't Just +Work). + +You can also use old-style C<Type>s which end with "Single" or "Multiple", for +example: SelectSingle, SelectMultiple, FreeformSingle, etc. + +=item C<Values> + +C<Values> should be an array ref (never a single value!) of hashrefs +representing new L<RT::CustomFieldValue> objects to create for the new custom +field. This only makes sense for "Select" CFs. An example: + + my $i = 1; + push @CustomFields, { + Queue => 0, # Globally applied + LookupType => 'RT::Queue-RT::Ticket', # for Tickets + Name => 'Type of food', + Type => 'SelectSingle', # SelectSingle is the same as: Type => 'Select', MaxValues => 1 + RenderType => 'Dropdown', + Values => [ + { Name => 'Fruit', Description => 'Berries, peaches, tomatos, etc', SortOrder => $i++ }, + { Name => 'Vegetable', Description => 'Asparagus, peas, lettuce, etc', SortOrder => $i++ }, + # more values as such... + ], + }; + +In order to ensure the same sorting of C<Values>, set C<SortOrder> inside each +value. A clever way to do this easily is with a simple variable you increment +each time (as above with C<$i>). You can use the same variable throughout the +whole file, and don't need one per CF. + +=item C<BasedOn> + +Name or ID of another Select Custom Field. This makes the named CF the source +of categories for your values. + +=item C<Pattern> + +The regular expression text (not C<qr//>!) used to validate values. + +=back + +Refer to the documentation and implementation of L<RT::CustomField/Create> and +L<RT::CustomFieldValue/Create> for the full list of available fields and +allowed values. + +=head2 C<@ACL> + +C<@ACL> is very useful for granting rights on your newly created records or +setting up a standard system configuration. It is one of the most complex +initialdata structures. + +=head3 Pick a Right + +All ACL definitions expect a key named C<Right> with the internal right name +you want to grant. The internal right names are visible in RT's admin +interface in grey next to the longer descriptions. + +=head3 Pick a level: on a queue, on a CF, or globally + +After picking a C<Right>, you need to specify on what object the right is +granted. This is B<different> than the user/group/role receiving the right. + +=over 4 + +=item Granted on a custom field by name (or ID), potentially a global or queue + + CF => 'Name', + +=item Granted on a queue + + Queue => 'Name', + +=item Granted on a custom field applied to a specific queue + + CF => 'Name', + Queue => 'Name', + +=item Granted globally + +Specifying none of the above will get you a global right. + +=back + +There is currently no way to grant rights on a group or article class level. +Note that you can grant rights B<to> a group; see below. If you need to grants +rights on a group or article class level, you'll need to write an C<@Final> +subref to handle it using the RT Perl API. + +=head3 Pick a Principal: User or Group or Role + +Finally you need to specify to what system group, system/queue role, +user defined group, or user you want to grant the right B<to>. + +=over 4 + +=item An internal user group + + GroupDomain => 'SystemInternal', + GroupType => 'Everyone, Privileged, or Unprivileged' + +=item A system-level role + + GroupDomain => 'RT::System-Role', + GroupType => 'Requestor, Owner, AdminCc, or Cc' + +=item A queue-level role + + GroupDomain => 'RT::Queue-Role', + Queue => 'Name', + GroupType => 'Requestor, Owner, AdminCc, or Cc', + +=item A group you created + + GroupDomain => 'UserDefined', + GroupId => 'Name' + +=item Individual user + + UserId => 'Name or email or ID' + +=back + +=head3 Common cases + +You're probably looking for definitions like these most of the time. + +=over 4 + +=item Grant a global right to a group you created + + { Right => '...', + GroupDomain => 'UserDefined', + GroupId => 'Name' } + +=item Grant a queue-level right to a group you created + + { Queue => 'Name', + Right => '...', + GroupDomain => 'UserDefined', + GroupId => 'Name' } + +=item Grant a CF-level right to a group you created + + { CF => 'Name', + Right => '...', + GroupDomain => 'UserDefined', + GroupId => 'Name' } + +=back + +Since you often want to grant a list of rights on the same object/level to the +same role/group/user, we generally use Perl loops and operators to aid in the +generation of C<@ACL> without repeating ourselves. + + # Give Requestors globally the right to see tickets, reply, and see the + # queue their ticket is in + push @ACL, map { + { + Right => $_, + GroupDomain => 'RT::System-Role', + GroupType => 'Requestor', + } + } qw(ShowTicket ReplyToTicket SeeQueue); + +=head3 Troubleshooting + +The best troubleshooting is often to see how the rights you define in C<@ACL> +show up in the RT admin interface. + +=head2 C<@Scrips> + +Creates a new L<RT::Scrip> for each hashref. Refer to the documentation of +L<RT::Scrip/Create> for the fields you can use. + +Additionally, the C<Queue> field is specially handled to make it easier to +setup the same Scrip on multiple queues: + +=over 4 + +=item Globally + + Queue => 0, + +=item Single queue + + Queue => 'General', # Name or ID + +=item Multiple queues + + Queue => ['General', 'Helpdesk', 13], # Array ref of Name or ID + +=back + +=head2 C<@ScripActions> + +Creates a new L<RT::ScripAction> for each hashref. Refer to the documentation +of L<RT::ScripAction/Create> for the fields you can use. + +=head2 C<@ScripConditions> + +Creates a new L<RT::ScripCondition> for each hashref. Refer to the +documentation of L<RT::ScripCondition/Create> for the fields you can use. + +=head2 C<@Templates> + +Creates a new L<RT::Template> for each hashref. Refer to the documentation of +L<RT::Template/Create> for the fields you can use. + +=head2 C<@Attributes> + +An array of L<RT::Attribute>s to create. You likely don't need to mess with +this. If you do, know that the key C<Object> is expected to be an +L<RT::Record> object on which to call C<AddAttribute>. If you don't provide +C<Object> or it's undefined, C<< RT->System >> will be used. + +=head2 C<@Initial> + +=head2 C<@Final> + +C<@Initial> and C<@Final> are special and let you write your own processing +code that runs before anything else or after everything else. They are +expected to be arrays of subrefs (usually anonymous) like so: + + our @Final = (sub { + RT->Logger->info("Finishing up!"); + }); + +You have the full power of RT's Perl libraries at your disposal. Be sure to do +error checking and log any errors with C<< RT->Logger->error("...") >>! + +=head1 What's missing? + +There is currently no way, short of writing code in C<@Final> or C<@Initial>, +to easily create B<Classes>, B<Topics>, or B<Articles> from initialdata files. + +=head1 Running an initialdata file + + sbin/rt-setup-database --action insert --datafile /path/to/your/initialdata + +This may prompt you for a database password. + +=head1 Implementation details + +All the handling of initialdata files is done in C<< RT::Handle->InsertData >>. +If you want to know B<exactly> what's happening with each array, your best bet +is to start reading the code there. + +RT takes care of the ordering so that your new queues are created before it +processes the new ACLs for those queues. This lets you refer to new queues you +just created by Name. diff --git a/rt/etc/RT_Config.pm b/rt/etc/RT_Config.pm new file mode 100644 index 000000000..a7fab946b --- /dev/null +++ b/rt/etc/RT_Config.pm @@ -0,0 +1,2814 @@ +# +# RT was configured with: +# +# $ ./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pass= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2 +# + +package RT; + +############################# WARNING ############################# +# # +# NEVER EDIT RT_Config.pm ! # +# # +# Instead, copy any sections you want to change to # +# RT_SiteConfig.pm and edit them there. Otherwise, # +# your changes will be lost when you upgrade RT. # +# # +############################# WARNING ############################# + +=head1 NAME + +RT::Config + +=head1 Base configuration + +=over 4 + +=item C<$rtname> + +C<$rtname> is the string that RT will look for in mail messages to +figure out what ticket a new piece of mail belongs to. + +Your domain name is recommended, so as not to pollute the namespace. +Once you start using a given tag, you should probably never change it; +otherwise, mail for existing tickets won't get put in the right place. + +=cut + +Set($rtname, "example.com"); + +=item C<$Organization> + +You should set this to your organization's DNS domain. For example, +I<fsck.com> or I<asylum.arkham.ma.us>. It is used by the linking +interface to guarantee that ticket URIs are unique and easy to +construct. Changing it after you have created tickets in the system +will B<break> all existing ticket links! + +=cut + +Set($Organization, "example.com"); + +=item C<$CorrespondAddress>, C<$CommentAddress> + +RT is designed such that any mail which already has a ticket-id +associated with it will get to the right place automatically. + +C<$CorrespondAddress> and C<$CommentAddress> are the default addresses +that will be listed in From: and Reply-To: headers of correspondence +and comment mail tracked by RT, unless overridden by a queue-specific +address. They should be set to email addresses which have been +configured as aliases for F<rt-mailgate>. + +=cut + +Set($CorrespondAddress, ''); + +Set($CommentAddress, ''); + +=item C<$WebDomain> + +Domain name of the RT server, e.g. 'www.example.com'. It should not +contain anything except the server name. + +=cut + +Set($WebDomain, "localhost"); + +=item C<$WebPort> + +If we're running as a superuser, run on port 80. Otherwise, pick a +high port for this user. + +443 is default port for https protocol. + +=cut + +Set($WebPort, 80); + +=item C<$WebPath> + +If you're putting the web UI somewhere other than at the root of your +server, you should set C<$WebPath> to the path you'll be serving RT +at. + +C<$WebPath> requires a leading / but no trailing /, or it can be +blank. + +In most cases, you should leave C<$WebPath> set to "" (an empty +value). + +=cut + +Set($WebPath, ""); + +=item C<$Timezone> + +C<$Timezone> is the default timezone, used to convert times entered by +users into GMT, as they are stored in the database, and back again; +users can override this. It should be set to a timezone recognized by +your server. + +=cut + +Set($Timezone, "US/Eastern"); + +=item C<@Plugins> + +Set C<@Plugins> to a list of external RT plugins that should be +enabled (those plugins have to be previously downloaded and +installed). + +Example: + +C<Set(@Plugins, (qw(RT::Extension::SLA RT::Authen::ExternalAuth)));> + +=cut + +Set(@Plugins, (qw(RTx::Calendar + RT::Extension::MobileUI))); #RTx::Checklist )); + +=back + + + + +=head1 Database connection + +=over 4 + +=item C<$DatabaseType> + +Database driver being used; case matters. Valid types are "mysql", +"Oracle" and "Pg". + +=cut + +Set($DatabaseType, "Pg"); + +=item C<$DatabaseHost>, C<$DatabaseRTHost> + +The domain name of your database server. If you're running MySQL and +on localhost, leave it blank for enhanced performance. + +C<DatabaseRTHost> is the fully-qualified hostname of your RT server, +for use in granting ACL rights on MySQL. + +=cut + +Set($DatabaseHost, "localhost"); +Set($DatabaseRTHost, "localhost"); + +=item C<$DatabasePort> + +The port that your database server is running on. Ignored unless it's +a positive integer. It's usually safe to leave this blank; RT will +choose the correct default. + +=cut + +Set($DatabasePort, ""); + +=item C<$DatabaseUser> + +The name of the user to connect to the database as. + +=cut + +Set($DatabaseUser, "freeside"); + +=item C<$DatabasePassword> + +The password the C<$DatabaseUser> should use to access the database. + +=cut + +Set($DatabasePassword, q{}); + +=item C<$DatabaseName> + +The name of the RT database on your database server. For Oracle, the +SID and database objects are created in C<$DatabaseUser>'s schema. + +=cut + +Set($DatabaseName, q{freeside}); + +=item C<$DatabaseRequireSSL> + +If you're using PostgreSQL and have compiled in SSL support, set +C<$DatabaseRequireSSL> to 1 to turn on SSL communication with the +database. + +=cut + +Set($DatabaseRequireSSL, undef); + +=back + + + + +=head1 Logging + +The default is to log anything except debugging information to syslog. +Check the L<Log::Dispatch> POD for information about how to get things +by syslog, mail or anything else, get debugging info in the log, etc. + +It might generally make sense to send error and higher by email to +some administrator. If you do this, be careful that this email isn't +sent to this RT instance. Mail loops will generate a critical log +message. + +=over 4 + +=item C<$LogToSyslog>, C<$LogToScreen> + +The minimum level error that will be logged to the specific device. +From lowest to highest priority, the levels are: + + debug info notice warning error critical alert emergency + +Many syslogds are configured to discard or file debug messages away, so +if you're attempting to debug RT you may need to reconfigure your +syslogd or use one of the other logging options. + +Logging to your screen affects scripts run from the command line as well +as the STDERR sent to your webserver (so these logs will usually show up +in your web server's error logs). + +=cut + +Set($LogToSyslog, "info"); +Set($LogToScreen, "info"); + +=item C<$LogToFile>, C<$LogDir>, C<$LogToFileNamed> + +Logging to a standalone file is also possible. The file needs to both +exist and be writable by all direct users of the RT API. This generally +includes the web server and whoever rt-crontool runs as. Note that +rt-mailgate and the RT CLI go through the webserver, so their users do +not need to have write permissions to this file. If you expect to have +multiple users of the direct API, Best Practical recommends using syslog +instead of direct file logging. + +You should set C<$LogToFile> to one of the levels documented above. + +=cut + +Set($LogToFile, undef); +Set($LogDir, q{/opt/rt3/var/log}); +Set($LogToFileNamed, "rt.log"); #log to rt.log + +=item C<$LogStackTraces> + +If set to a log level then logging will include stack traces for +messages with level equal to or greater than specified. + +NOTICE: Stack traces include parameters supplied to functions or +methods. It is possible for stack trace logging to reveal sensitive +information such as passwords or ticket content in your logs. + +=cut + +Set($LogStackTraces, ""); + +=item C<@LogToSyslogConf> + +On Solaris or UnixWare, set to ( socket => 'inet' ). Options here +override any other options RT passes to L<Log::Dispatch::Syslog>. +Other interesting flags include facility and logopt. (See the +L<Log::Dispatch::Syslog> documentation for more information.) (Maybe +ident too, if you have multiple RT installations.) + +=cut + +Set(@LogToSyslogConf, ()); + +=back + + + +=head1 Incoming mail gateway + +=over 4 + +=item C<$EmailSubjectTagRegex> + +This regexp controls what subject tags RT recognizes as its own. If +you're not dealing with historical C<$rtname> values, or historical +queue-specific subject tags, you'll likely never have to change this +configuration. + +Be B<very careful> with it. Note that it overrides C<$rtname> for +subject token matching and that you should use only "non-capturing" +parenthesis grouping. For example: + +C<Set($EmailSubjectTagRegex, qr/(?:example.com|example.org)/i );> + +and NOT + +C<Set($EmailSubjectTagRegex, qr/(example.com|example.org)/i );> + +The setting below would make RT behave exactly as it does without the +setting enabled. + +=cut + +# Set($EmailSubjectTagRegex, qr/\Q$rtname\E/i ); + +=item C<$OwnerEmail> + +C<$OwnerEmail> is the address of a human who manages RT. RT will send +errors generated by the mail gateway to this address. This address +should I<not> be an address that's managed by your RT instance. + +=cut + +Set($OwnerEmail, 'root'); + +=item C<$LoopsToRTOwner> + +If C<$LoopsToRTOwner> is defined, RT will send mail that it believes +might be a loop to C<$OwnerEmail>. + +=cut + +Set($LoopsToRTOwner, 1); + +=item C<$StoreLoops> + +If C<$StoreLoops> is defined, RT will record messages that it believes +to be part of mail loops. As it does this, it will try to be careful +not to send mail to the sender of these messages. + +=cut + +Set($StoreLoops, undef); + +=item C<$MaxAttachmentSize> + +C<$MaxAttachmentSize> sets the maximum size (in bytes) of attachments +stored in the database. This setting is irrelevant unless one of +$TruncateLongAttachments or $DropLongAttachments (below) are set. + +=cut + +Set($MaxAttachmentSize, 10_000_000); + +=item C<$TruncateLongAttachments> + +If this is set to a non-undef value, RT will truncate attachments +longer than C<$MaxAttachmentSize>. + +=cut + +Set($TruncateLongAttachments, undef); + +=item C<$DropLongAttachments> + +If this is set to a non-undef value, RT will silently drop attachments +longer than C<MaxAttachmentSize>. C<$TruncateLongAttachments>, above, +takes priority over this. + +=cut + +Set($DropLongAttachments, undef); + +=item C<$RTAddressRegexp> + +C<$RTAddressRegexp> is used to make sure RT doesn't add itself as a +ticket CC if C<$ParseNewMessageForTicketCcs>, above, is enabled. It +is important that you set this to a regular expression that matches +all addresses used by your RT. This lets RT avoid sending mail to +itself. It will also hide RT addresses from the list of "One-time Cc" +and Bcc lists on ticket reply. + +If you have a number of addresses configured in your RT database +already, you can generate a naive first pass regexp by using: + + perl etc/upgrade/generate-rtaddressregexp + +If left blank, RT will compare each address to your configured +C<$CorrespondAddress> and C<$CommentAddress> before searching for a +Queue configured with a matching "Reply Address" or "Comment Address" +on the Queue Admin page. + +=cut + +Set($RTAddressRegexp, undef); + +=item C<$IgnoreCcRegexp> + +C<$IgnoreCcRegexp> is a regexp to exclude addresses from automatic addition +to the Cc list. Use this for addresses that are I<not> received by RT but +are sometimes added to Cc lists by mistake. Unlike C<$RTAddressRegexp>, +these addresses can still receive email from RT otherwise. + +=cut + +Set($IgnoreCcRegexp, undef); + +=item C<$CanonicalizeEmailAddressMatch>, C<$CanonicalizeEmailAddressReplace> + +RT provides functionality which allows the system to rewrite incoming +email addresses. In its simplest form, you can substitute the value +in C<CanonicalizeEmailAddressReplace> for the value in +C<CanonicalizeEmailAddressMatch> (These values are passed to the +C<CanonicalizeEmailAddress> subroutine in F<RT/User.pm>) + +By default, that routine performs a C<s/$Match/$Replace/gi> on any +address passed to it. + +=cut + +# Set($CanonicalizeEmailAddressMatch, '@subdomain\.example\.com$'); +# Set($CanonicalizeEmailAddressReplace, '@example.com'); + +=item C<$CanonicalizeOnCreate> + +Set this to 1 and the create new user page will use the values that +you enter in the form but use the function CanonicalizeUserInfo in +F<RT/User_Local.pm> + +=cut + +Set($CanonicalizeOnCreate, 0); + +=item C<$ValidateUserEmailAddresses> + +If C<$ValidateUserEmailAddresses> is 1, RT will refuse to create +users with an invalid email address (as specified in RFC 2822) or with +an email address made of multiple email addresses. + +=cut + +Set($ValidateUserEmailAddresses, undef); + +=item C<$NonCustomerEmailRegexp> + +Normally, when a ticket is linked to a customer, any requestors on that +ticket that didn't previously have customer memberships are linked to +the customer also. C<$NonCustomerEmailRegexp> is a regexp for email +addresses that should I<not> automatically be linked to a customer in +this way. + +=cut + +Set($NonCustomerEmailRegexp, undef); + +=item C<@MailPlugins> + +C<@MailPlugins> is a list of authentication plugins for +L<RT::Interface::Email> to use; see L<rt-mailgate> + +=cut + +=item C<$UnsafeEmailCommands> + +C<$UnsafeEmailCommands>, if set to 1, enables 'take' and 'resolve' +as possible actions via the mail gateway. As its name implies, this +is very unsafe, as it allows email with a forged sender to possibly +resolve arbitrary tickets! + +=cut + +=item C<$ExtractSubjectTagMatch>, C<$ExtractSubjectTagNoMatch> + +The default "extract remote tracking tags" scrip settings; these +detect when your RT is talking to another RT, and adjust the subject +accordingly. + +=cut + +Set($ExtractSubjectTagMatch, qr/\[[^\]]+? #\d+\]/); +Set($ExtractSubjectTagNoMatch, ( ${RT::EmailSubjectTagRegex} + ? qr/\[(?:${RT::EmailSubjectTagRegex}) #\d+\]/ + : qr/\[\Q$RT::rtname\E #\d+\]/)); + +=item C<$CheckMoreMSMailHeaders> + +Some email clients create a plain text version of HTML-formatted +email to help other clients that read only plain text. +Unfortunately, the plain text parts sometimes end up with +doubled newlines and these can then end up in RT. This +is most often seen in MS Outlook. + +Enable this option to have RT check for additional mail headers +and attempt to identify email from MS Outlook. When detected, +RT will then clean up double newlines. Note that it may +clean up intentional double newlines as well. + +=cut + +Set( $CheckMoreMSMailHeaders, 0); + +=back + + + +=head1 Outgoing mail + +=over 4 + +=item C<$MailCommand> + +C<$MailCommand> defines which method RT will use to try to send mail. +We know that 'sendmailpipe' works fairly well. If 'sendmailpipe' +doesn't work well for you, try 'sendmail'. Other options are 'smtp' +or 'qmail'. + +Note that you should remove the '-t' from C<$SendmailArguments> if you +use 'sendmail' rather than 'sendmailpipe' + +For testing purposes, or to simply disable sending mail out into the +world, you can set C<$MailCommand> to 'testfile' which writes all mail +to a temporary file. RT will log the location of the temporary file +so you can extract mail from it afterward. + +On shutdown, RT will clean up the temporary file created when using +the 'testfile' option. If testing while the RT server is still running, +you can find the files in the location noted in the log file. If you run +a tool like C<rt-crontool> however, or if you look after stopping the server, +the files will have been deleted when the process completed. If you need to +keep the files for development or debugging, you can manually set +C<< UNLINK => 0 >> where the testfile config is processed in +F<lib/RT/Interface/Email.pm>. + +=cut + +#Set($MailCommand, "sendmailpipe"); +Set($MailCommand, "sendmail"); + +=item C<$SetOutgoingMailFrom> + +C<$SetOutgoingMailFrom> tells RT to set the sender envelope to the +Correspond mail address of the ticket's queue. + +Warning: If you use this setting, bounced mails will appear to be +incoming mail to the system, thus creating new tickets. + +If the value contains an C<@>, it is assumed to be an email address and used as +a global envelope sender. Expected usage in this case is to simply set the +same envelope sender on all mail from RT, without defining +C<$OverrideOutgoingMailFrom>. If you do define C<$OverrideOutgoingMailFrom>, +anything specified there overrides the global value (including Default). + +This option only works if C<$MailCommand> is set to 'sendmailpipe'. + +=cut + +Set($SetOutgoingMailFrom, 0); + +=item C<$OverrideOutgoingMailFrom> + +C<$OverrideOutgoingMailFrom> is used for overwriting the Correspond +address of the queue as it is handed to sendmail -f. This helps force +the From_ header away from www-data or other email addresses that show +up in the "Sent by" line in Outlook. + +The option is a hash reference of queue name to email address. If +there is no ticket involved, then the value of the C<Default> key will +be used. + +This option only works if C<$SetOutgoingMailFrom> is enabled and +C<$MailCommand> is set to 'sendmailpipe'. + +=cut + +Set($OverrideOutgoingMailFrom, { +# 'Default' => 'admin@rt.example.com', +# 'General' => 'general@rt.example.com', +}); + +=item C<$DefaultMailPrecedence> + +C<$DefaultMailPrecedence> is used to control the default Precedence +level of outgoing mail where none is specified. By default it is +C<bulk>, but if you only send mail to your staff, you may wish to +change it. + +Note that you can set the precedence of individual templates by +including an explicit Precedence header. + +If you set this value to C<undef> then we do not set a default +Precedence header to outgoing mail. However, if there already is a +Precedence header, it will be preserved. + +=cut + +Set($DefaultMailPrecedence, "bulk"); + +=item C<$DefaultErrorMailPrecedence> + +C<$DefaultErrorMailPrecedence> is used to control the default +Precedence level of outgoing mail that indicates some kind of error +condition. By default it is C<bulk>, but if you only send mail to your +staff, you may wish to change it. + +If you set this value to C<undef> then we do not add a Precedence +header to error mail. + +=cut + +Set($DefaultErrorMailPrecedence, "bulk"); + +=item C<$UseOriginatorHeader> + +C<$UseOriginatorHeader> is used to control the insertion of an +RT-Originator Header in every outgoing mail, containing the mail +address of the transaction creator. + +=cut + +Set($UseOriginatorHeader, 1); + +=item C<$UseFriendlyFromLine> + +By default, RT sets the outgoing mail's "From:" header to "SenderName +via RT". Setting C<$UseFriendlyFromLine> to 0 disables it. + +=cut + +Set($UseFriendlyFromLine, 1); + +=item C<$FriendlyFromLineFormat> + +C<sprintf()> format of the friendly 'From:' header; its arguments are +SenderName and SenderEmailAddress. + +=cut + +Set($FriendlyFromLineFormat, "\"%s via RT\" <%s>"); + +=item C<$UseFriendlyToLine> + +RT can optionally set a "Friendly" 'To:' header when sending messages +to Ccs or AdminCcs (rather than having a blank 'To:' header. + +This feature DOES NOT WORK WITH SENDMAIL[tm] BRAND SENDMAIL. If you +are using sendmail, rather than postfix, qmail, exim or some other +MTA, you _must_ disable this option. + +=cut + +Set($UseFriendlyToLine, 0); + +=item C<$FriendlyToLineFormat> + +C<sprintf()> format of the friendly 'To:' header; its arguments are +WatcherType and TicketId. + +=cut + +Set($FriendlyToLineFormat, "\"%s of ". RT->Config->Get('rtname') ." Ticket #%s\":;"); + +=item C<$NotifyActor> + +By default, RT doesn't notify the person who performs an update, as +they already know what they've done. If you'd like to change this +behavior, Set C<$NotifyActor> to 1 + +=cut + +Set($NotifyActor, 0); + +=item C<$RecordOutgoingEmail> + +By default, RT records each message it sends out to its own internal +database. To change this behavior, set C<$RecordOutgoingEmail> to 0 + +If this is disabled, users' digest mail delivery preferences +(i.e. EmailFrequency) will also be ignored. + +=cut + +Set($RecordOutgoingEmail, 1); + +=item C<$VERPPrefix>, C<$VERPDomain> + +Setting these options enables VERP support +L<http://cr.yp.to/proto/verp.txt>. + +Uncomment the following two directives to generate envelope senders +of the form C<${VERPPrefix}${originaladdress}@${VERPDomain}> +(i.e. rt-jesse=fsck.com@rt.example.com ). + +This currently only works with sendmail and sendmailpipe. + +=cut + +# Set($VERPPrefix, "rt-"); +# Set($VERPDomain, $RT::Organization); + + +=item C<$ForwardFromUser> + +By default, RT forwards a message using queue's address and adds RT's +tag into subject of the outgoing message, so recipients' replies go +into RT as correspondents. + +To change this behavior, set C<$ForwardFromUser> to 1 and RT +will use the address of the current user and remove RT's subject tag. + +=cut + +Set($ForwardFromUser, 0); + +=back + +=head2 Email dashboards + +=over 4 + +=item C<$DashboardAddress> + +The email address from which RT will send dashboards. If none is set, +then C<$OwnerEmail> will be used. + +=cut + +Set($DashboardAddress, ''); + +=item C<$DashboardSubject> + +Lets you set the subject of dashboards. Arguments are the frequency (Daily, +Weekly, Monthly) of the dashboard and the dashboard's name. + +=cut + +Set($DashboardSubject, "%s Dashboard: %s"); + +=item C<@EmailDashboardRemove> + +A list of regular expressions that will be used to remove content from +mailed dashboards. + +=cut + +Set(@EmailDashboardRemove, ()); + +=back + + + +=head2 Sendmail configuration + +These options only take effect if C<$MailCommand> is 'sendmail' or +'sendmailpipe' + +=over 4 + +=item C<$SendmailArguments> + +C<$SendmailArguments> defines what flags to pass to C<$SendmailPath> +If you picked 'sendmailpipe', you MUST add a -t flag to +C<$SendmailArguments> These options are good for most sendmail +wrappers and work-a-likes. + +These arguments are good for sendmail brand sendmail 8 and newer: +C<Set($SendmailArguments,"-oi -t -ODeliveryMode=b -OErrorMode=m");> + +=cut + +#Set($SendmailArguments, "-oi -t"); +Set($SendmailArguments, "-oi"); + + +=item C<$SendmailBounceArguments> + +C<$SendmailBounceArguments> defines what flags to pass to C<$Sendmail> +assuming RT needs to send an error (i.e. bounce). + +=cut + +Set($SendmailBounceArguments, '-f "<>"'); + +=item C<$SendmailPath> + +If you selected 'sendmailpipe' above, you MUST specify the path to +your sendmail binary in C<$SendmailPath>. + +=cut + +Set($SendmailPath, "/usr/sbin/sendmail"); + + +=back + +=head2 SMTP configuration + +These options only take effect if C<$MailCommand> is 'smtp' + +=over 4 + +=item C<$SMTPServer> + +C<$SMTPServer> should be set to the hostname of the SMTP server to use + +=cut + +Set($SMTPServer, undef); + +=item C<$SMTPFrom> + +C<$SMTPFrom> should be set to the 'From' address to use, if not the +email's 'From' + +=cut + +Set($SMTPFrom, undef); + +=item C<$SMTPDebug> + +C<$SMTPDebug> should be set to 1 to debug SMTP mail sending + +=cut + +Set($SMTPDebug, 0); + +=back + +=head2 Other mailers + +=over 4 + +=item C<@MailParams> + +C<@MailParams> defines a list of options passed to $MailCommand if it +is not 'sendmailpipe', 'sendmail', or 'smtp' + +=cut + +Set(@MailParams, ()); + +=back + + +=head1 Web interface + +=over 4 + +=item C<$WebDefaultStylesheet> + +This determines the default stylesheet the RT web interface will use. +RT ships with several themes by default: + + web2 The default layout for RT 3.8 + aileron The default layout for RT 4.0 + ballard Theme which doesn't rely on JavaScript for menuing + +This bundled distibution of RT also includes: + freeside3 Integration with Freeside (enabled by default) + freeside2.1 Previous Freeside theme + +This value actually specifies a directory in F<share/html/NoAuth/css/> +from which RT will try to load the file main.css (which should @import +any other files the stylesheet needs). This allows you to easily and +cleanly create your own stylesheets to apply to RT. This option can +be overridden by users in their preferences. + +=cut + +Set($WebDefaultStylesheet, "freeside3"); + +=item C<$DefaultQueue> + +Use this to select the default queue name that will be used for +creating new tickets. You may use either the queue's name or its +ID. This only affects the queue selection boxes on the web interface. + +=cut + +# Set($DefaultQueue, "General"); + +=item C<$RememberDefaultQueue> + +When a queue is selected in the new ticket dropdown, make it the new +default for the new ticket dropdown. + +=cut + +# Set($RememberDefaultQueue, 1); + +=item C<$EnableReminders> + +Hide all links and portlets related to Reminders by setting this to 0 + +=cut + +Set($EnableReminders, 1); + +=item C<@CustomFieldValuesSources> + +Set C<@CustomFieldValuesSources> to a list of class names which extend +L<RT::CustomFieldValues::External>. This can be used to pull lists of +custom field values from external sources at runtime. + +=cut + +Set(@CustomFieldValuesSources, ('RT::CustomFieldValues::Queues')); + +=item C<$CanonicalizeRedirectURLs> + +Set C<$CanonicalizeRedirectURLs> to 1 to use C<$WebURL> when +redirecting rather than the one we get from C<%ENV>. + +Apache's UseCanonicalName directive changes the hostname that RT +finds in C<%ENV>. You can read more about what turning it On or Off +means in the documentation for your version of Apache. + +If you use RT behind a reverse proxy, you almost certainly want to +enable this option. + +=cut + +Set($CanonicalizeRedirectURLs, 0); + +=item C<@JSFiles> + +A list of JavaScript files to be included in head. Removing any of +the default entries is not suggested. + +If you're a plugin author, refer to RT->AddJavaScript. + +=cut + +Set(@JSFiles, qw/ + jquery-1.4.2.min.js + jquery_noconflict.js + jquery-ui-1.8.4.custom.min.js + jquery-ui-timepicker-addon.js + jquery-ui-patch-datepicker.js + jquery.cookie.js + titlebox-state.js + util.js + userautocomplete.js + jquery.event.hover-1.0.js + superfish.js + supersubs.js + jquery.supposition.js + history-folding.js + late.js +/); + +=item C<$JSMinPath> + +Path to the jsmin binary; if specified, it will be used to minify +C<JSFiles>. The default, and the fallback if the binary cannot be +found, is to simply concatenate the files. + +jsmin can be installed by running 'make jsmin' from the RT install +directory, or from http://www.crockford.com/javascript/jsmin.html + +=cut + +# Set($JSMinPath, "/path/to/jsmin"); + +=item C<@CSSFiles> + +A list of additional CSS files to be included in head. + +If you're a plugin author, refer to RT->AddStyleSheets. + +=cut + +Set(@CSSFiles, qw//); + +=item C<$UsernameFormat> + +This determines how user info is displayed. 'concise' will show one of +either NickName, RealName, Name or EmailAddress, depending on what +exists and whether the user is privileged or not. 'verbose' will show +RealName and EmailAddress. + +=cut + +Set($UsernameFormat, "verbose"); + +=item C<$WebBaseURL>, C<$WebURL> + +Usually you don't want to set these options. The only obvious reason +is if RT is accessible via https protocol on a non standard port, e.g. +'https://rt.example.com:9999'. In all other cases these options are +computed using C<$WebDomain>, C<$WebPort> and C<$WebPath>. + +C<$WebBaseURL> is the scheme, server and port +(e.g. 'http://rt.example.com') for constructing URLs to the web +UI. C<$WebBaseURL> doesn't need a trailing /. + +C<$WebURL> is the C<$WebBaseURL>, C<$WebPath> and trailing /, for +example: 'http://www.example.com/rt/'. + +=cut + +my $port = RT->Config->Get('WebPort'); +Set($WebBaseURL, + ($port == 443? 'https': 'http') .'://' + . RT->Config->Get('WebDomain') + . ($port != 80 && $port != 443? ":$port" : '') +); + +Set($WebURL, RT->Config->Get('WebBaseURL') . RT->Config->Get('WebPath') . "/"); + +=item C<$WebImagesURL> + +C<$WebImagesURL> points to the base URL where RT can find its images. +Define the directory name to be used for images in RT web documents. + +=cut + +Set($WebImagesURL, RT->Config->Get('WebPath') . "/NoAuth/images/"); + +=item C<$LogoURL> + +C<$LogoURL> points to the URL of the RT logo displayed in the web UI. +This can also be configured via the web UI. + +=cut + +Set($LogoURL, RT->Config->Get('WebImagesURL') . "bpslogo.png"); + +=item C<$LogoLinkURL> + +C<$LogoLinkURL> is the URL that the RT logo hyperlinks to. + +=cut + +Set($LogoLinkURL, "http://bestpractical.com"); + +=item C<$LogoAltText> + +C<$LogoAltText> is a string of text for the alt-text of the logo. It +will be passed through C<loc> for localization. + +=cut + +Set($LogoAltText, "Best Practical Solutions, LLC corporate logo"); + +=item C<$LogoImageHeight> + +C<$LogoImageHeight> is the value of the C<height> attribute of the logo +C<img> tag. + +=cut + +Set($LogoImageHeight, 38); + +=item C<$LogoImageWidth> + +C<$LogoImageWidth> is the value of the C<width> attribute of the logo +C<img> tag. + +=cut + +Set($LogoImageWidth, 181); + +=item C<$WebNoAuthRegex> + +What portion of RT's URL space should not require authentication. The +default is almost certainly correct, and should only be changed if you +are extending RT. + +=cut + +Set($WebNoAuthRegex, qr{^ /rt (?:/+NoAuth/ | /+REST/\d+\.\d+/NoAuth/) }x ); + +=item C<$SelfServiceRegex> + +What portion of RT's URLspace should be accessible to Unprivileged +users This does not override the redirect from F</Ticket/Display.html> +to F</SelfService/Display.html> when Unprivileged users attempt to +access ticked displays. + +=cut + +Set($SelfServiceRegex, qr!^(?:/+SelfService/)!x ); + +=item C<$WebFlushDbCacheEveryRequest> + +By default, RT clears its database cache after every page view. This +ensures that you've always got the most current information when +working in a multi-process (mod_perl or FastCGI) Environment. Setting +C<$WebFlushDbCacheEveryRequest> to 0 will turn this off, which will +speed RT up a bit, at the expense of a tiny bit of data accuracy. + +=cut + +Set($WebFlushDbCacheEveryRequest, 1); + +=item C<%ChartFont> + +The L<GD> module (which RT uses for graphs) ships with a built-in font +that doesn't have full Unicode support. You can use a given TrueType +font for a specific language by setting %ChartFont to (language =E<gt> +the absolute path of a font) pairs. Your GD library must have support +for TrueType fonts to use this option. If there is no entry for a +language in the hash then font with 'others' key is used. + +RT comes with two TrueType fonts covering most available languages. + +=cut + +Set( + %ChartFont, + 'zh-cn' => "$RT::BasePath/share/fonts/DroidSansFallback.ttf", + 'zh-tw' => "$RT::BasePath/share/fonts/DroidSansFallback.ttf", + 'ja' => "$RT::BasePath/share/fonts/DroidSansFallback.ttf", + 'others' => "$RT::BasePath/share/fonts/DroidSans.ttf", +); + +=item C<$ChartsTimezonesInDB> + +RT stores dates using the UTC timezone in the DB, so charts grouped by +dates and time are not representative. Set C<$ChartsTimezonesInDB> to 1 +to enable timezone conversions using your DB's capabilities. You may +need to do some work on the DB side to use this feature, read more in +F<docs/customizing/timezones_in_charts.pod>. + +At this time, this feature only applies to MySQL and PostgreSQL. + +=cut + +Set($ChartsTimezonesInDB, 0); + +=back + + + +=head2 Home page + +=over 4 + +=item C<$DefaultSummaryRows> + +C<$DefaultSummaryRows> is default number of rows displayed in for +search results on the front page. + +=cut + +Set($DefaultSummaryRows, 10); + +=item C<$HomePageRefreshInterval> + +C<$HomePageRefreshInterval> is default number of seconds to refresh +the RT home page. Choose from [0, 120, 300, 600, 1200, 3600, 7200]. + +=cut + +Set($HomePageRefreshInterval, 0); + +=item C<$HomepageComponents> + +C<$HomepageComponents> is an arrayref of allowed components on a +user's customized homepage ("RT at a glance"). + +=cut + +Set( + $HomepageComponents, + [ + qw(QuickCreate Quicksearch MyCalendar MyAdminQueues MySupportQueues MyReminders RefreshHomepage Dashboards SavedSearches ) # loc_qw + ] +); + +=back + + + + +=head2 Ticket search + +=over 4 + +=item C<$UseSQLForACLChecks> + +Historically, ACLs were checked on display, which could lead to empty +search pages and wrong ticket counts. Set C<$UseSQLForACLChecks> to 1 +to limit search results in SQL instead, which eliminates these +problems. + +This option is still relatively new; it may result in performance +problems in some cases, or significant speedups in others. + +=cut + +Set($UseSQLForACLChecks, undef); + +=item C<$TicketsItemMapSize> + +On the display page of a ticket from search results, RT provides links +to the first, next, previous and last ticket from the results. In +order to build these links, RT needs to fetch the full result set from +the database, which can be resource-intensive. + +Set C<$TicketsItemMapSize> to number of tickets you want RT to examine +to build these links. If the full result set is larger than this +number, RT will omit the "last" link in the menu. Set this to zero to +always examine all results. + +=cut + +Set($TicketsItemMapSize, 1000); + +=item C<$SearchResultsRefreshInterval> + +C<$SearchResultsRefreshInterval> is default number of seconds to +refresh search results in RT. Choose from [0, 120, 300, 600, 1200, +3600, 7200]. + +=cut + +Set($SearchResultsRefreshInterval, 0); + +=item C<$DefaultSearchResultFormat> + +C<$DefaultSearchResultFormat> is the default format for RT search +results + +=cut + +Set ($DefaultSearchResultFormat, qq{ + '<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__id__</a></B>/TITLE:#', + '<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a></B>/TITLE:Subject', + Customer, + Status, + QueueName, + OwnerName, + Priority, + '__NEWLINE__', + '__NBSP__', + '<small>__Requestors__</small>', + '<small>__CustomerTags__</small>', + '<small>__CreatedRelative__</small>', + '<small>__ToldRelative__</small>', + '<small>__LastUpdatedRelative__</small>', + '<small>__TimeLeft__</small>'}); + +=item C<$DefaultSelfServiceSearchResultFormat> + +C<$DefaultSelfServiceSearchResultFormat> is the default format of +searches displayed in the SelfService interface. + +=cut + +Set($DefaultSelfServiceSearchResultFormat, qq{ + '<B><A HREF="__WebPath__/SelfService/Display.html?id=__id__">__id__</a></B>/TITLE:#', + '<B><A HREF="__WebPath__/SelfService/Display.html?id=__id__">__Subject__</a></B>/TITLE:Subject', + Status, + Requestors, + OwnerName}); + +=item C<%FullTextSearch> + +Full text search (FTS) without database indexing is a very slow +operation, and is thus disabled by default. + +Before setting C<Indexed> to 1, read F<docs/full_text_indexing.pod> for +the full details of FTS on your particular database. + +It is possible to enable FTS without database indexing support, simply +by setting the C<Enable> key to 1, while leaving C<Indexed> set to 0. +This is not generally suggested, as unindexed full-text searching can +cause severe performance problems. + +=cut + +Set(%FullTextSearch, + Enable => 0, + Indexed => 0, +); + +=item C<$DontSearchFileAttachments> + +If C<$DontSearchFileAttachments> is set to 1, then uploaded files +(attachments with file names) are not searched during content +search. + +Note that if you use indexed FTS then named attachments are still +indexed by default regardless of this option. + +=cut + +Set($DontSearchFileAttachments, undef); + +=item C<$OnlySearchActiveTicketsInSimpleSearch> + +When query in simple search doesn't have status info, use this to only +search active ones. + +=cut + +Set($OnlySearchActiveTicketsInSimpleSearch, 1); + +=item C<$SearchResultsAutoRedirect> + +When only one ticket is found in search, use this to redirect to the +ticket display page automatically. + +=cut + +Set($SearchResultsAutoRedirect, 0); + +=back + + + +=head2 Ticket display + +=over 4 + +=item C<$ShowMoreAboutPrivilegedUsers> + +This determines if the 'More about requestor' box on +Ticket/Display.html is shown for Privileged Users. + +=cut + +Set($ShowMoreAboutPrivilegedUsers, 0); + +=item C<$MoreAboutRequestorTicketList> + +This can be set to Active, Inactive, All or None. It controls what +ticket list will be displayed in the 'More about requestor' box on +Ticket/Display.html. This option can be controlled by users also. + +=cut + +Set($MoreAboutRequestorTicketList, "Active"); + +=item C<$MoreAboutRequestorExtraInfo> + +By default, the 'More about requestor' box on Ticket/Display.html +shows the Requestor's name and ticket list. If you would like to see +extra information about the user, this expects a Format string of user +attributes. Please note that not all the attributes are supported in +this display because we're not building a table. + +Example: +C<Set($MoreAboutRequestorExtraInfo,"Organization, Address1")> + +=cut + +Set($MoreAboutRequestorExtraInfo, ""); + +=item C<$MoreAboutRequestorGroupsLimit> + +By default, the 'More about requestor' box on Ticket/Display.html +shows all the groups of the Requestor. Use this to limit the number +of groups; a value of undef removes the group display entirely. + +=cut + +Set($MoreAboutRequestorGroupsLimit, 0); + +=item C<$UseSideBySideLayout> + +Should the ticket create and update forms use a more space efficient +two column layout. This layout may not work in narrow browsers if you +set a MessageBoxWidth (below). + +=cut + +Set($UseSideBySideLayout, 1); + +=item C<$EditCustomFieldsSingleColumn> + +When displaying a list of Ticket Custom Fields for editing, RT +defaults to a 2 column list. If you set this to 1, it will instead +display the Custom Fields in a single column. + +=cut + +Set($EditCustomFieldsSingleColumn, 0); + +=item C<$ShowUnreadMessageNotifications> + +If set to 1, RT will prompt users when there are new, +unread messages on tickets they are viewing. + +=cut + +Set($ShowUnreadMessageNotifications, 0); + +=item C<$AutocompleteOwners> + +If set to 1, the owner drop-downs for ticket update/modify and the query +builder are replaced by text fields that autocomplete. This can +alleviate the sometimes huge owner list for installations where many +users have the OwnTicket right. + +=cut + +Set($AutocompleteOwners, 0); + +=item C<$AutocompleteOwnersForSearch> + +If set to 1, the owner drop-downs for the query builder are always +replaced by text field that autocomplete and C<$AutocompleteOwners> +is ignored. Helpful when owners list is huge in the query builder. + +=cut + +Set($AutocompleteOwnersForSearch, 0); + +=item C<$UserAutocompleteFields> + +Specifies which fields of L<RT::User> to match against and how to +match each field when autocompleting users. Valid match methods are +LIKE, STARTSWITH, ENDSWITH, =, and !=. + +=cut + +Set($UserAutocompleteFields, { + EmailAddress => 'STARTSWITH', + Name => 'STARTSWITH', + RealName => 'LIKE', +}); + +=item C<$AllowUserAutocompleteForUnprivileged> + +Should unprivileged users be allowed to autocomplete users. Setting +this option to 1 means unprivileged users will be able to search all +your users. + +=cut + +Set($AllowUserAutocompleteForUnprivileged, 0); + +=item C<$DisplayTicketAfterQuickCreate> + +Enable this to redirect to the created ticket display page +automatically when using QuickCreate. + +=cut + +Set($DisplayTicketAfterQuickCreate, 0); + +=item C<$WikiImplicitLinks> + +Support implicit links in WikiText custom fields? Setting this to 1 +causes InterCapped or ALLCAPS words in WikiText fields to automatically +become links to searches for those words. If used on Articles, it links +to the Article with that name. + +=cut + +Set($WikiImplicitLinks, 0); + +=item C<$PreviewScripMessages> + +Set C<$PreviewScripMessages> to 1 if the scrips preview on the ticket +reply page should include the content of the messages to be sent. + +=cut + +Set($PreviewScripMessages, 0); + +=item C<$SimplifiedRecipients> + +If C<$SimplifiedRecipients> is set, a simple list of who will receive +B<any> kind of mail will be shown on the ticket reply page, instead of a +detailed breakdown by scrip. + +=cut + +Set($SimplifiedRecipients, 0); + +=item C<$HideResolveActionsWithDependencies> + +If set to 1, this option will skip ticket menu actions which can't be +completed successfully because of outstanding active Depends On tickets. + +By default, all ticket actions are displayed in the menu even if some of +them can't be successful until all Depends On links are resolved or +transitioned to another inactive status. + +=cut + +Set($HideResolveActionsWithDependencies, 0); + +=back + + + +=head2 Articles + +=over 4 + +=item C<$ArticleOnTicketCreate> + +Set this to 1 to display the Articles interface on the Ticket Create +page in addition to the Reply/Comment page. + +=cut + +Set($ArticleOnTicketCreate, 0); + +=item C<$HideArticleSearchOnReplyCreate> + +Set this to 1 to hide the search and include boxes from the Article +UI. This assumes you have enabled Article Hotlist feature, otherwise +you will have no access to Articles. + +=cut + +Set($HideArticleSearchOnReplyCreate, 0); + +=back + + + +=head2 Message box properties + +=over 4 + +=item C<$MessageBoxWidth>, C<$MessageBoxHeight> + +For message boxes, set the entry box width, height and what type of +wrapping to use. These options can be overridden by users in their +preferences. + +When the width is set to undef, no column count is specified and the +message box will take up 100% of the available width. Combining this +with HARD messagebox wrapping (below) is not recommended, as it will +lead to inconsistent width in transactions between browsers. + +These settings only apply to the non-RichText message box. See below +for Rich Text settings. + +=cut + +Set($MessageBoxWidth, undef); +Set($MessageBoxHeight, 15); + +=item C<$MessageBoxWrap> + +Wrapping is disabled when using MessageBoxRichText because of a bad +interaction between IE and wrapping with the Rich Text Editor. + +=cut + +Set($MessageBoxWrap, "SOFT"); + +=item C<$MessageBoxRichText> + +Should "rich text" editing be enabled? This option lets your users +send HTML email messages from the web interface. + +=cut + +Set($MessageBoxRichText, 1); + +=item C<$MessageBoxRichTextHeight> + +Height of rich text JavaScript enabled editing boxes (in pixels) + +=cut + +Set($MessageBoxRichTextHeight, 200); + +=item C<$MessageBoxIncludeSignature> + +Should your users' signatures (from their Preferences page) be +included in Comments and Replies. + +=cut + +Set($MessageBoxIncludeSignature, 1); + +=item C<$MessageBoxIncludeSignatureOnComment> + +Should your users' signatures (from their Preferences page) be +included in Comments. Setting this to false overrides +C<$MessageBoxIncludeSignature>. + +=cut + +Set($MessageBoxIncludeSignatureOnComment, 1); + +=back + + +=head2 Transaction display + +=over 4 + +=item C<$OldestTransactionsFirst> + +By default, RT shows newest transactions at the bottom of the ticket +history page, if you want see them at the top set this to 0. This +option can be overridden by users in their preferences. + +=cut + +Set($OldestTransactionsFirst, 1); + +=item C<$DeferTransactionLoading> + +When set, defers loading ticket history until the user clicks a link. +This should end up serving pages to users quicker, since generating +all the HTML for transaction history can be slow for long tickets. + +=cut + +# Set($DeferTransactionLoading, 1); + +=item C<$ShowBccHeader> + +By default, RT hides from the web UI information about blind copies +user sent on reply or comment. + +=cut + +Set($ShowBccHeader, 0); + +=item C<$TrustHTMLAttachments> + +If C<TrustHTMLAttachments> is not defined, we will display them as +text. This prevents malicious HTML and JavaScript from being sent in a +request (although there is probably more to it than that) + +=cut + +Set($TrustHTMLAttachments, undef); + +=item C<$AlwaysDownloadAttachments> + +Always download attachments, regardless of content type. If set, this +overrides C<TrustHTMLAttachments>. + +=cut + +Set($AlwaysDownloadAttachments, undef); + +=item C<$AttachmentUnits> + +Controls the units (kilobytes or bytes) that attachment sizes use for +display. The default is to display kilobytes if the attachment is +larger than 1024 bytes, bytes otherwise. If you set +C<$AttachmentUnits> to C<'k'> then attachment sizes will always be +displayed in kilobytes. If set to C<'b'>, then sizes will be bytes. + +=cut + +Set($AttachmentUnits, undef); + +=item C<$PreferRichText> + +If C<$PreferRichText> is set to 1, RT will show HTML/Rich text messages +in preference to their plain-text alternatives. RT "scrubs" the HTML to +show only a minimal subset of HTML to avoid possible contamination by +cross-site-scripting attacks. + +=cut + +Set($PreferRichText, undef); + +=item C<$MaxInlineBody> + +C<$MaxInlineBody> is the maximum attachment size that we want to see +inline when viewing a transaction. RT will inline any text if the +value is undefined or 0. This option can be overridden by users in +their preferences. + +=cut + +Set($MaxInlineBody, 12000); + +=item C<$ShowTransactionImages> + +By default, RT shows images attached to incoming (and outgoing) ticket +updates inline. Set this variable to 0 if you'd like to disable that +behavior. + +=cut + +Set($ShowTransactionImages, 1); + +=item C<$PlainTextPre> + +Normally plaintext attachments are displayed as HTML with line breaks +preserved. This causes space- and tab-based formatting not to be +displayed correctly. By setting $PlainTextPre messages will be +displayed using <pre>. + +=cut + +Set($PlainTextPre, 0); + + +=item C<$PlainTextMono> + +Set C<$PlainTextMono> to 1 to use monospaced font and preserve +formatting; unlike C<$PlainTextPre>, the text will wrap to fit width +of the browser window; this option overrides C<$PlainTextPre>. + +=cut + +Set($PlainTextMono, 0); + +=item C<$SuppressInlineTextFiles> + +If C<$SuppressInlineTextFiles> is set to 1, then uploaded text files +(text-type attachments with file names) are prevented from being +displayed in-line when viewing a ticket's history. + +=cut + +Set($SuppressInlineTextFiles, undef); + + +=item C<@Active_MakeClicky> + +MakeClicky detects various formats of data in headers and email +messages, and extends them with supporting links. By default, RT +provides two formats: + +* 'httpurl': detects http:// and https:// URLs and adds '[Open URL]' + link after the URL. + +* 'httpurl_overwrite': also detects URLs as 'httpurl' format, but + replaces the URL with a link. + +See F<share/html/Elements/MakeClicky> for documentation on how to add +your own styles of link detection. + +=cut + +Set(@Active_MakeClicky, qw()); + +=back + + + +=head1 Application logic + +=over 4 + +=item C<$ParseNewMessageForTicketCcs> + +If C<$ParseNewMessageForTicketCcs> is set to 1, RT will attempt to +divine Ticket 'Cc' watchers from the To and Cc lines of incoming +messages that create new Tickets. This option does not apply to replies +or comments on existing Tickets. Be forewarned that if you have I<any> +addresses which forward mail to RT automatically and you enable this +option without modifying C<$RTAddressRegexp> below, you will get +yourself into a heap of trouble. + +=cut + +Set($ParseNewMessageForTicketCcs, undef); + +=item C<$UseTransactionBatch> + +Set C<$UseTransactionBatch> to 1 to execute transactions in batches, +such that a resolve and comment (for example) would happen +simultaneously, instead of as two transactions, unaware of each +others' existence. + +=cut + +Set($UseTransactionBatch, 1); + +=item C<$StrictLinkACL> + +When this feature is enabled a user needs I<ModifyTicket> rights on +both tickets to link them together; otherwise, I<ModifyTicket> rights +on either of them is sufficient. + +=cut + +Set($StrictLinkACL, 1); + +=item C<$RedistributeAutoGeneratedMessages> + +Should RT redistribute correspondence that it identifies as machine +generated? A 1 will do so; setting this to 0 will cause no +such messages to be redistributed. You can also use 'privileged' (the +default), which will redistribute only to privileged users. This helps +to protect against malformed bounces and loops caused by auto-created +requestors with bogus addresses. + +=cut + +Set($RedistributeAutoGeneratedMessages, "privileged"); + +=item C<$ApprovalRejectionNotes> + +Should rejection notes from approvals be sent to the requestors? + +=cut + +Set($ApprovalRejectionNotes, 1); + +=item C<$ForceApprovalsView> + +Should approval tickets only be viewed and modified through the standard +approval interface? Changing this setting to 1 will redirect any attempt to +use the normal ticket display and modify page for approval tickets. + +For example, with this option set to 1 and an approval ticket #123: + + /Ticket/Display.html?id=123 + +is redirected to + + /Approval/Display.html?id=123 + +=back + +=cut + +Set($ForceApprovalsView, 0); + +=head1 Extra security + +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<ExecuteCode> right will be removed from +all users, B<including> the superuser. This is intended for when RT is +installed into a shared environment where even the superuser should not +be allowed to run arbitrary Perl code on the server via scrips. + +=cut + +Set($DisallowExecuteCode, 0); + +=item C<$Framebusting> + +If set to a false value, framekiller javascript will be disabled and the +X-Frame-Options: DENY header will be suppressed from all responses. +This disables RT's clickjacking protection. + +=cut + +Set($Framebusting, 1); + +=item C<$RestrictReferrer> + +If set to a false value, the HTTP C<Referer> (sic) header will not be +checked to ensure that requests come from RT's own domain. As RT allows +for GET requests to alter state, disabling this opens RT up to +cross-site request forgery (CSRF) attacks. + +=cut + +Set($RestrictReferrer, 1); + +=item C<$RestrictLoginReferrer> + +If set to a false value, RT will allow the user to log in from any link +or request, merely by passing in C<user> and C<pass> parameters; setting +it to a true value forces all logins to come from the login box, so the +user is aware that they are being logged in. The default is off, for +backwards compatability. + +=cut + +Set($RestrictLoginReferrer, 0); + +=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 +multiple hostnames or have an external auth system that needs to +redirect back to RT once authentication is complete. + + Set(@ReferrerWhitelist, qw(www.example.com:443 www3.example.com:80)); + +If the "RT has detected a possible cross-site request forgery" error is triggered +by a host:port sent by your browser that you believe should be valid, you can copy +the host:port from the error message into this list. + +Simple wildcards, similar to SSL certificates, are allowed. For example: + + *.example.com:80 # matches foo.example.com + # but not example.com + # or foo.bar.example.com + + www*.example.com:80 # matches www3.example.com + # and www-test.example.com + # and www.example.com + +=cut + +Set(@ReferrerWhitelist, qw()); + +=back + + + +=head1 Authorization and user configuration + +=over 4 + +=item C<$WebExternalAuth> + +If C<$WebExternalAuth> is defined, RT will defer to the environment's +REMOTE_USER variable. + +=cut + +Set($WebExternalAuth, undef); + +=item C<$WebExternalAuthContinuous> + +If C<$WebExternalAuthContinuous> is defined, RT will check for the +REMOTE_USER on each access. If you would prefer this to only happen +once (at initial login) set this to a false value. The default +setting will help ensure that if your external authentication system +deauthenticates a user, RT notices as soon as possible. + +=cut + +Set($WebExternalAuthContinuous, 1); + +=item C<$WebFallbackToInternalAuth> + +If C<$WebFallbackToInternalAuth> is defined, the user is allowed a +chance of fallback to the login screen, even if REMOTE_USER failed. + +=cut + +Set($WebFallbackToInternalAuth, undef); + +=item C<$WebExternalGecos> + +C<$WebExternalGecos> means to match 'gecos' field as the user +identity); useful with mod_auth_pwcheck and IIS Integrated Windows +logon. + +=cut + +Set($WebExternalGecos, undef); + +=item C<$WebExternalAuto> + +C<$WebExternalAuto> will create users under the same name as +REMOTE_USER upon login, if it's missing in the Users table. + +=cut + +Set($WebExternalAuto, undef); + +=item C<$AutoCreate> + +If C<$WebExternalAuto> is set to 1, C<$AutoCreate> will be passed to +User's Create method. Use it to set defaults, such as creating +Unprivileged users with C<{ Privileged => 0 }> This must be a hashref. + +=cut + +Set($AutoCreate, undef); + +=item C<$WebSessionClass> + +C<$WebSessionClass> is the class you wish to use for managing sessions. +It defaults to use your SQL database, except on Oracle, where it +defaults to files on disk. + +=cut + +# Set($WebSessionClass, "Apache::Session::File"); + +=item C<$AutoLogoff> + +By default, RT's user sessions persist until a user closes his or her +browser. With the C<$AutoLogoff> option you can setup session lifetime +in minutes. A user will be logged out if he or she doesn't send any +requests to RT for the defined time. + +=cut + +Set($AutoLogoff, 0); + +=item C<$LogoutRefresh> + +The number of seconds to wait after logout before sending the user to +the login page. By default, 1 second, though you may want to increase +this if you display additional information on the logout page. + +=cut + +Set($LogoutRefresh, 1); + +=item C<$WebSecureCookies> + +By default, RT's session cookie isn't marked as "secure". Some web +browsers will treat secure cookies more carefully than non-secure +ones, being careful not to write them to disk, only sending them over +an SSL secured connection, and so on. To enable this behavior, set +C<$WebSecureCookies> to 1. NOTE: You probably don't want to turn this +on I<unless> users are only connecting via SSL encrypted HTTPS +connections. + +=cut + +Set($WebSecureCookies, 0); + +=item C<$WebHttpOnlyCookies> + +Default RT's session cookie to not being directly accessible to +javascript. The content is still sent during regular and AJAX requests, +and other cookies are unaffected, but the session-id is less +programmatically accessible to javascript. Turning this off should only +be necessary in situations with odd client-side authentication +requirements. + +=cut + +Set($WebHttpOnlyCookies, 1); + +=item C<$MinimumPasswordLength> + +C<$MinimumPasswordLength> defines the minimum length for user +passwords. Setting it to 0 disables this check. + +=cut + +Set($MinimumPasswordLength, 5); + +=back + + +=head1 Internationalization + +=over 4 + +=item C<@LexiconLanguages> + +An array that contains languages supported by RT's +internationalization interface. Defaults to all *.po lexicons; +setting it to C<qw(en ja)> will make RT bilingual instead of +multilingual, but will save some memory. + +=cut + +Set(@LexiconLanguages, qw(*)); + +=item C<@EmailInputEncodings> + +An array that contains default encodings used to guess which charset +an attachment uses, if it does not specify one explicitly. All +options must be recognized by L<Encode::Guess>. The first element may +also be '*', which enables encoding detection using +L<Encode::Detect::Detector>, if installed. + +=cut + +Set(@EmailInputEncodings, qw(utf-8 iso-8859-1 us-ascii)); + +=item C<$EmailOutputEncoding> + +The charset for localized email. Must be recognized by Encode. + +=cut + +Set($EmailOutputEncoding, "utf-8"); + +=back + + + + + + + +=head1 Date and time handling + +=over 4 + +=item C<$DateTimeFormat> + +You can choose date and time format. See the "Output formatters" +section in perldoc F<lib/RT/Date.pm> for more options. This option +can be overridden by users in their preferences. + +Some examples: + +C<Set($DateTimeFormat, "LocalizedDateTime");> +C<Set($DateTimeFormat, { Format => "ISO", Seconds => 0 });> +C<Set($DateTimeFormat, "RFC2822");> +C<Set($DateTimeFormat, { Format => "RFC2822", Seconds => 0, DayOfWeek => 0 });> + +=cut + +Set($DateTimeFormat, "DefaultFormat"); + +# Next two options are for Time::ParseDate + +=item C<$DateDayBeforeMonth> + +Set this to 1 if your local date convention looks like "dd/mm/yy" +instead of "mm/dd/yy". Used only for parsing, not for displaying +dates. + +=cut + +Set($DateDayBeforeMonth, 1); + +=item C<$AmbiguousDayInPast>, C<$AmbiguousDayInFuture> + +Should an unspecified day or year in a date refer to a future or a +past value? For example, should a date of "Tuesday" default to mean +the date for next Tuesday or last Tuesday? Should the date "March 1" +default to the date for next March or last March? + +Set C<$AmbiguousDayInPast> for the last date, or +C<$AmbiguousDayInFuture> for the next date; the default is usually +correct. If both are set, C<$AmbiguousDayInPast> takes precedence. + +=cut + +Set($AmbiguousDayInPast, 0); +Set($AmbiguousDayInFuture, 0); + +=item C<$DefaultTimeUnitsToHours> + +Use this to set the default units for time entry to hours instead of +minutes. Note that this only effects entry, not display. + +=cut + +Set($DefaultTimeUnitsToHours, 0); + +=item C<$SimpleSearchIncludeResolved> + +By default, the simple ticket search in the top bar excludes "resolved" tickets +unless a status argument is specified. Set this to a true value to include +them. + +=cut + +Set($SimpleSearchIncludeResolved, 0); + +=back + + + + +=head1 GnuPG integration + +A full description of the (somewhat extensive) GnuPG integration can +be found by running the command `perldoc L<RT::Crypt::GnuPG>` (or +`perldoc lib/RT/Crypt/GnuPG.pm` from your RT install directory). + +=over 4 + +=item C<%GnuPG> + +Set C<OutgoingMessagesFormat> to 'inline' to use inline encryption and +signatures instead of 'RFC' (GPG/MIME: RFC3156 and RFC1847) format. + +If you want to allow people to encrypt attachments inside the DB then +set C<AllowEncryptDataInDB> to 1. + +Set C<RejectOnMissingPrivateKey> to false if you don't want to reject +emails encrypted for key RT doesn't have and can not decrypt. + +Set C<RejectOnBadData> to false if you don't want to reject letters +with incorrect GnuPG data. + +=cut + +Set(%GnuPG, + Enable => 1, + OutgoingMessagesFormat => "RFC", # Inline + AllowEncryptDataInDB => 0, + + RejectOnMissingPrivateKey => 1, + RejectOnBadData => 1, +); + +=item C<%GnuPGOptions> + +Options to pass to the GnuPG program. + +If you override this in your RT_SiteConfig, you should be sure to +include a homedir setting. + +Note that options with '-' character MUST be quoted. + +=cut + +Set(%GnuPGOptions, + homedir => q{/opt/rt3/var/data/gpg}, + +# URL of a keyserver +# keyserver => 'hkp://subkeys.pgp.net', + +# enables the automatic retrieving of keys when encrypting +# 'auto-key-locate' => 'keyserver', + +# enables the automatic retrieving of keys when verifying signatures +# 'keyserver-options' => 'auto-key-retrieve', +); + +=back + + + +=head1 Lifecycles + +=head2 Lifecycle definitions + +Each lifecycle is a list of possible statuses split into three logic +sets: B<initial>, B<active> and B<inactive>. Each status in a +lifecycle must be unique. (Statuses may not be repeated across sets.) +Each set may have any number of statuses. + +For example: + + default => { + initial => ['new'], + active => ['open', 'stalled'], + inactive => ['resolved', 'rejected', 'deleted'], + ... + }, + +Status names can be from 1 to 64 ASCII characters. Statuses are +localized using RT's standard internationalization and localization +system. + +=over 4 + +=item initial + +You can define multiple B<initial> statuses for tickets in a given +lifecycle. + +RT will automatically set its B<Started> date when you change a +ticket's status from an B<initial> state to an B<active> or +B<inactive> status. + +=item active + +B<Active> tickets are "currently in play" - they're things that are +being worked on and not yet complete. + +=item inactive + +B<Inactive> tickets are typically in their "final resting state". + +While you're free to implement a workflow that ignores that +description, typically once a ticket enters an inactive state, it will +never again enter an active state. + +RT will automatically set the B<Resolved> date when a ticket's status +is changed from an B<Initial> or B<Active> status to an B<Inactive> +status. + +B<deleted> is still a special status and protected by the +B<DeleteTicket> right, unless you re-defined rights (read below). If +you don't want to allow ticket deletion at any time simply don't +include it in your lifecycle. + +=back + +Statuses in each set are ordered and listed in the UI in the defined +order. + +Changes between statuses are constrained by transition rules, as +described below. + +=head2 Default values + +In some cases a default value is used to display in UI or in API when +value is not provided. You can configure defaults using the following +syntax: + + default => { + ... + defaults => { + on_create => 'new', + on_resolve => 'resolved', + ... + }, + }, + +The following defaults are used. + +=over 4 + +=item on_create + +If you (or your code) doesn't specify a status when creating a ticket, +RT will use the this status. See also L</Statuses available during +ticket creation>. + +=item on_merge + +When tickets are merged, the status of the ticket that was merged +away is forced to this value. It should be one of inactive statuses; +'resolved' or its equivalent is most probably the best candidate. + +=item approved + +When an approval is accepted, the status of depending tickets will +be changed to this value. + +=item denied + +When an approval is denied, the status of depending tickets will +be changed to this value. + +=item reminder_on_open + +When a reminder is opened, the status will be changed to this value. + +=item reminder_on_resolve + +When a reminder is resolved, the status will be changed to this value. + +=back + +=head2 Transitions between statuses and UI actions + +A B<Transition> is a change of status from A to B. You should define +all possible transitions in each lifecycle using the following format: + + default => { + ... + transitions => { + '' => [qw(new open resolved)], + new => [qw(open resolved rejected deleted)], + open => [qw(stalled resolved rejected deleted)], + stalled => [qw(open)], + resolved => [qw(open)], + rejected => [qw(open)], + deleted => [qw(open)], + }, + ... + }, + +=head3 Statuses available during ticket creation + +By default users can create tickets with a status of new, +open, or resolved, but cannot create tickets with a status of +rejected, stalled, or deleted. If you want to change the statuses +available during creation, update the transition from '' (empty +string), like in the example above. + +=head3 Protecting status changes with rights + +A transition or group of transitions can be protected by a specific +right. Additionally, you can name new right names, which will be added +to the system to control that transition. For example, if you wished to +create a lesser right than ModifyTicket for rejecting tickets, you could +write: + + default => { + ... + rights => { + '* -> deleted' => 'DeleteTicket', + '* -> rejected' => 'RejectTicket', + '* -> *' => 'ModifyTicket', + }, + ... + }, + +This would create a new C<RejectTicket> right in the system which you +could assign to whatever groups you choose. + +On the left hand side you can have the following variants: + + '<from> -> <to>' + '* -> <to>' + '<from> -> *' + '* -> *' + +Valid transitions are listed in order of priority. If a user attempts +to change a ticket's status from B<new> to B<open> then the lifecycle +is checked for presence of an exact match, then for 'any to B<open>', +'B<new> to any' and finally 'any to any'. + +If you don't define any rights, or there is no match for a transition, +RT will use the B<DeleteTicket> or B<ModifyTicket> as appropriate. + +=head3 Labeling and defining actions + +For each transition you can define an action that will be shown in the +UI; each action annotated with a label and an update type. + +Each action may provide a default update type, which can be +B<Comment>, B<Respond>, or absent. For example, you may want your +staff to write a reply to the end user when they change status from +B<new> to B<open>, and thus set the update to B<Respond>. Neither +B<Comment> nor B<Respond> are mandatory, and user may leave the +message empty, regardless of the update type. + +This configuration can be used to accomplish what +$ResolveDefaultUpdateType was used for in RT 3.8. + +Use the following format to define labels and actions of transitions: + + default => { + ... + actions => [ + 'new -> open' => { label => 'Open it', update => 'Respond' }, + 'new -> resolved' => { label => 'Resolve', update => 'Comment' }, + 'new -> rejected' => { label => 'Reject', update => 'Respond' }, + 'new -> deleted' => { label => 'Delete' }, + + 'open -> stalled' => { label => 'Stall', update => 'Comment' }, + 'open -> resolved' => { label => 'Resolve', update => 'Comment' }, + 'open -> rejected' => { label => 'Reject', update => 'Respond' }, + + 'stalled -> open' => { label => 'Open it' }, + 'resolved -> open' => { label => 'Re-open', update => 'Comment' }, + 'rejected -> open' => { label => 'Re-open', update => 'Comment' }, + 'deleted -> open' => { label => 'Undelete' }, + ], + ... + }, + +In addition, you may define multiple actions for the same transition. +Alternately, you may use '* -> x' to match more than one transition. +For example: + + default => { + ... + actions => [ + ... + 'new -> rejected' => { label => 'Reject', update => 'Respond' }, + 'new -> rejected' => { label => 'Quick Reject' }, + ... + '* -> deleted' => { label => 'Delete' }, + ... + ], + ... + }, + +=head2 Moving tickets between queues with different lifecycles + +Unless there is an explicit mapping between statuses in two different +lifecycles, you can not move tickets between queues with these +lifecycles. This is true even if the different lifecycles use the exact +same set of statuses. Such a mapping is defined as follows: + + __maps__ => { + 'from lifecycle -> to lifecycle' => { + 'status in left lifecycle' => 'status in right lifecycle', + ... + }, + ... + }, + +=cut + +Set(%Lifecycles, + default => { + initial => [ 'new' ], + active => [ 'open', 'stalled' ], + inactive => [ 'resolved', 'rejected', 'deleted' ], + + defaults => { + on_create => 'new', + on_merge => 'resolved', + approved => 'open', + denied => 'rejected', + reminder_on_open => 'open', + reminder_on_resolve => 'resolved', + }, + + transitions => { + '' => [qw(new open resolved)], + + # from => [ to list ], + new => [qw(open stalled resolved rejected deleted)], + open => [qw(new stalled resolved rejected deleted)], + stalled => [qw(new open rejected resolved deleted)], + resolved => [qw(new open stalled rejected deleted)], + rejected => [qw(new open stalled resolved deleted)], + deleted => [qw(new open stalled rejected resolved)], + }, + rights => { + '* -> deleted' => 'DeleteTicket', + '* -> *' => 'ModifyTicket', + }, + actions => [ + 'new -> open' => { + label => 'Open It', # loc + update => 'Respond', + }, + 'new -> resolved' => { + label => 'Resolve', # loc + update => 'Comment', + }, + 'new -> rejected' => { + label => 'Reject', # loc + update => 'Respond', + }, + 'new -> deleted' => { + label => 'Delete', # loc + }, + + 'open -> stalled' => { + label => 'Stall', # loc + update => 'Comment', + }, + 'open -> resolved' => { + label => 'Resolve', # loc + update => 'Comment', + }, + 'open -> rejected' => { + label => 'Reject', # loc + update => 'Respond', + }, + + 'stalled -> open' => { + label => 'Open It', # loc + }, + 'resolved -> open' => { + label => 'Re-open', # loc + update => 'Comment', + }, + 'rejected -> open' => { + label => 'Re-open', # loc + update => 'Comment', + }, + 'deleted -> open' => { + label => 'Undelete', # loc + }, + ], + }, +# don't change lifecyle of the approvals, they are not capable to deal with +# custom statuses + approvals => { + initial => [ 'new' ], + active => [ 'open', 'stalled' ], + inactive => [ 'resolved', 'rejected', 'deleted' ], + + defaults => { + on_create => 'new', + on_merge => 'resolved', + reminder_on_open => 'open', + reminder_on_resolve => 'resolved', + }, + + transitions => { + '' => [qw(new open resolved)], + + # from => [ to list ], + new => [qw(open stalled resolved rejected deleted)], + open => [qw(new stalled resolved rejected deleted)], + stalled => [qw(new open rejected resolved deleted)], + resolved => [qw(new open stalled rejected deleted)], + rejected => [qw(new open stalled resolved deleted)], + deleted => [qw(new open stalled rejected resolved)], + }, + rights => { + '* -> deleted' => 'DeleteTicket', + '* -> rejected' => 'ModifyTicket', + '* -> *' => 'ModifyTicket', + }, + actions => [ + 'new -> open' => { + label => 'Open It', # loc + update => 'Respond', + }, + 'new -> resolved' => { + label => 'Resolve', # loc + update => 'Comment', + }, + 'new -> rejected' => { + label => 'Reject', # loc + update => 'Respond', + }, + 'new -> deleted' => { + label => 'Delete', # loc + }, + + 'open -> stalled' => { + label => 'Stall', # loc + update => 'Comment', + }, + 'open -> resolved' => { + label => 'Resolve', # loc + update => 'Comment', + }, + 'open -> rejected' => { + label => 'Reject', # loc + update => 'Respond', + }, + + 'stalled -> open' => { + label => 'Open It', # loc + }, + 'resolved -> open' => { + label => 'Re-open', # loc + update => 'Comment', + }, + 'rejected -> open' => { + label => 'Re-open', # loc + update => 'Comment', + }, + 'deleted -> open' => { + label => 'Undelete', # loc + }, + ], + }, +); + + + + + +=head1 Administrative interface + +=over 4 + +=item C<$ShowRTPortal> + +RT can show administrators a feed of recent RT releases and other +related announcements and information from Best Practical on the top +level Configuration page. This feature helps you stay up to date on +RT security announcements and version updates. + +RT provides this feature using an "iframe" on C</Admin/index.html> +which asks the administrator's browser to show an inline page from +Best Practical's website. + +If you'd rather not make this feature available to your +administrators, set C<$ShowRTPortal> to a false value. + +=cut + +Set($ShowRTPortal, 1); + +=item C<%AdminSearchResultFormat> + +In the admin interface, format strings similar to tickets result +formats are used. Use C<%AdminSearchResultFormat> to define the format +strings used in the admin interface on a per-RT-class basis. + +=cut + +Set(%AdminSearchResultFormat, + Queues => + q{'<a href="__WebPath__/Admin/Queues/Modify.html?id=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/Queues/Modify.html?id=__id__">__Name__</a>/TITLE:Name'} + .q{,__Description__,__Address__,__Priority__,__DefaultDueIn__,__Disabled__,__Lifecycle__}, + + Groups => + q{'<a href="__WebPath__/Admin/Groups/Modify.html?id=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/Groups/Modify.html?id=__id__">__Name__</a>/TITLE:Name'} + .q{,'__Description__'}, + + Users => + q{'<a href="__WebPath__/Admin/Users/Modify.html?id=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/Users/Modify.html?id=__id__">__Name__</a>/TITLE:Name'} + .q{,__RealName__, __EmailAddress__}, + + CustomFields => + q{'<a href="__WebPath__/Admin/CustomFields/Modify.html?id=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/CustomFields/Modify.html?id=__id__">__Name__</a>/TITLE:Name'} + .q{,__AppliedTo__, __FriendlyType__, __FriendlyPattern__}, + + Scrips => + q{'<a href="__WebPath__/Admin/Queues/Scrip.html?id=__id__&Queue=__QueueId__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/Queues/Scrip.html?id=__id__&Queue=__QueueId__">__Description__</a>/TITLE:Description'} + .q{,__Stage__, __Condition__, __Action__, __Template__}, + + GlobalScrips => + q{'<a href="__WebPath__/Admin/Global/Scrip.html?id=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/Global/Scrip.html?id=__id__">__Description__</a>/TITLE:Description'} + .q{,__Stage__, __Condition__, __Action__, __Template__}, + + Templates => + q{'<a href="__WebPath__/__WebRequestPathDir__/Template.html?Queue=__QueueId__&Template=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/__WebRequestPathDir__/Template.html?Queue=__QueueId__&Template=__id__">__Name__</a>/TITLE:Name'} + .q{,'__Description__'}, + Classes => + q{ '<a href="__WebPath__/Admin/Articles/Classes/Modify.html?id=__id__">__id__</a>/TITLE:#'} + .q{,'<a href="__WebPath__/Admin/Articles/Classes/Modify.html?id=__id__">__Name__</a>/TITLE:Name'} + .q{,__Description__}, +); + +=back + + + + +=head1 Development options + +=over 4 + +=item C<$DevelMode> + +RT comes with a "Development mode" setting. This setting, as a +convenience for developers, turns on several of development options +that you most likely don't want in production: + +=over 4 + +=item * + +Disables CSS and JS minification and concatenation. Both CSS and JS +will be instead be served as a number of individual smaller files, +unchanged from how they are stored on disk. + +=item * + +Uses L<Module::Refresh> to reload changed Perl modules on each +request. + +=item * + +Turns off Mason's C<static_source> directive; this causes Mason to +reload template files which have been modified on disk. + +=item * + +Turns on Mason's HTML C<error_format>; this renders compilation errors +to the browser, along with a full stack trace. It is possible for +stack traces to reveal sensitive information such as passwords or +ticket content. + +=item * + +Turns off caching of callbacks; this enables additional callbacks to +be added while the server is running. + +=back + +=cut + +Set($DevelMode, "0"); + + +=item C<$RecordBaseClass> + +What abstract base class should RT use for its records. You should +probably never change this. + +Valid values are C<DBIx::SearchBuilder::Record> or +C<DBIx::SearchBuilder::Record::Cachable> + +=cut + +Set($RecordBaseClass, "DBIx::SearchBuilder::Record::Cachable"); + + +=item C<@MasonParameters> + +C<@MasonParameters> is the list of parameters for the constructor of +HTML::Mason's Apache or CGI Handler. This is normally only useful for +debugging, e.g. profiling individual components with: + + use MasonX::Profiler; # available on CPAN + Set(@MasonParameters, (preamble => 'my $p = MasonX::Profiler->new($m, $r);')); + +=cut + +Set(@MasonParameters, ()); + +=item C<$StatementLog> + +RT has rudimentary SQL statement logging support; simply set +C<$StatementLog> to be the level that you wish SQL statements to be +logged at. + +Enabling this option will also expose the SQL Queries page in the +Configuration -> Tools menu for SuperUsers. + +=cut + +Set($StatementLog, undef); + +=back + + + + +=head1 Deprecated options + +=over 4 + +=item C<$LinkTransactionsRun1Scrip> + +RT-3.4 backward compatibility setting. Add/Delete Link used to record +one transaction and run one scrip. Set this value to 1 if you want +only one of the link transactions to have scrips run. + +=cut + +Set($LinkTransactionsRun1Scrip, 0); + +=item C<$ResolveDefaultUpdateType> + +This option has been deprecated. You can configure this site-wide +with L</Lifecycles> (see L</Labeling and defining actions>). + +=back + +=cut + +1; diff --git a/rt/etc/upgrade/3.8-branded-queues-extension b/rt/etc/upgrade/3.8-branded-queues-extension new file mode 100755 index 000000000..5f6e38a42 --- /dev/null +++ b/rt/etc/upgrade/3.8-branded-queues-extension @@ -0,0 +1,95 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 lib "/opt/rt3/local/lib"; +use lib "/opt/rt3/lib"; + + +use RT; +RT::LoadConfig(); +RT::Init(); + +use RT::Queues; + +my $queues = RT::Queues->new( RT->SystemUser ); +$queues->UnLimit(); +while ( my $queue = $queues->Next ) { + print "Processing queue ". ($queue->Name || $queue->id) ."...\n"; + my $old_attr = $queue->FirstAttribute('BrandedSubjectTag'); + unless ( $old_attr ) { + print "\thas no old-style subject tag. skipping\n"; + next; + } + my $old_value = $old_attr->Content; + unless ( $old_value ) { + print "\thas empty old-style subject tag\n"; + } else { + my ($status, $msg) = $queue->SetSubjectTag( $old_value ); + unless ( $status ) { + print STDERR "\tERROR. Couldn't set tag: $msg\n"; + next; + } else { + print "\thave set new-style subject tag to '$old_value'\n"; + } + } + + my ($status, $msg) = $queue->DeleteAttribute('BrandedSubjectTag'); + unless ( $status ) { + print STDERR "\tERROR. Couldn't delete old-style tag: $msg\n"; + next; + } else { + print "\tdeleted old-style tag entry\n"; + } + print "\tDONE\n"; +} + +exit 0; + diff --git a/rt/etc/upgrade/3.8-ical-extension b/rt/etc/upgrade/3.8-ical-extension new file mode 100755 index 000000000..10239dc4e --- /dev/null +++ b/rt/etc/upgrade/3.8-ical-extension @@ -0,0 +1,96 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 lib "/opt/rt3/local/lib"; +use lib "/opt/rt3/lib"; + + +use RT; +RT::LoadConfig(); +RT::Init(); + +use RT::Attributes; +my $attrs = RT::Attributes->new( RT->SystemUser ); +$attrs->Limit(FIELD => 'ObjectType', OPERATOR=> '=', VALUE => 'RT::User'); +$attrs->Limit(FIELD => 'Name', OPERATOR=> '=', VALUE => 'ical-auth-token'); +while ( my $attr = $attrs->Next ) { + my $uid = $attr->ObjectId; + print "Processing auth token of user #". $uid ."...\n"; + + my $user = RT::User->new( RT->SystemUser ); + $user->Load( $uid ); + unless ( $user->id ) { + print STDERR "\tERROR. Couldn't load user record\n"; + next; + } + + my ($status, $msg); + + ($status, $msg) = $user->DeleteAttribute('AuthToken') + if $user->FirstAttribute('AuthToken'); + unless ( $status ) { + print STDERR "\tERROR. Couldn't delete duplicated attribute: $msg\n"; + next; + } else { + print "\tdeleted duplicate attribute\n"; + } + + ($status, $msg) = $attr->SetName('AuthToken'); + unless ( $status ) { + print STDERR "\tERROR. Couldn't rename attribute: $msg\n"; + next; + } else { + print "\trenamed attribute\n"; + } + print "\tDONE\n"; +} + +exit 0; diff --git a/rt/etc/upgrade/4.0-customfield-checkbox-extension b/rt/etc/upgrade/4.0-customfield-checkbox-extension new file mode 100755 index 000000000..a3db13cab --- /dev/null +++ b/rt/etc/upgrade/4.0-customfield-checkbox-extension @@ -0,0 +1,86 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 lib "/opt/rt3/local/lib"; +use lib "/opt/rt3/lib"; + +use RT; +RT::LoadConfig(); +RT::Init(); + +use RT::CustomFields; +my $cfs = RT::CustomFields->new( RT->SystemUser ); +$cfs->{find_disabled_rows} = 1; +$cfs->Limit( + FIELD => 'Type', + VALUE => 'SelectCheckbox', +); + +while ( my $cf = $cfs->Next ) { + print 'Processing custom field #' . $cf->id . "\n"; + my ( $ret, $msg ) = $cf->SetType('Select'); + unless ($ret) { + warn "Failed to set custom field #" + . $cf->id + . " Type to 'Select': $msg\n"; + } + + ( $ret, $msg ) = $cf->SetRenderType('List'); + unless ($ret) { + warn "Failed to set custom field #" + . $cf->id + . " RenderType to 'List': $msg\n"; + } +} + +print "DONE\n"; + +exit 0; diff --git a/rt/etc/upgrade/generate-rtaddressregexp b/rt/etc/upgrade/generate-rtaddressregexp new file mode 100755 index 000000000..729228a3a --- /dev/null +++ b/rt/etc/upgrade/generate-rtaddressregexp @@ -0,0 +1,109 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 lib "/opt/rt3/local/lib"; +use lib "/opt/rt3/lib"; + +use RT; +RT::LoadConfig(); +RT->Config->Set('LogToScreen' => 'debug'); +RT::Init(); + +$| = 1; + +if (my $re = RT->Config->Get('RTAddressRegexp')) { + print "No need to use this script, you already have RTAddressRegexp set to $re\n"; + exit; +} + +use RT::Queues; +my $queues = RT::Queues->new( RT->SystemUser ); +$queues->UnLimit; + +my %merged; +merge(\%merged, RT->Config->Get('CorrespondAddress'), RT->Config->Get('CommentAddress')); +while ( my $queue = $queues->Next ) { + merge(\%merged, $queue->CorrespondAddress, $queue->CommentAddress); +} + +my @domains; +for my $domain (sort keys %merged) { + my @addresses; + for my $base (sort keys %{$merged{$domain}}) { + my @subbits = keys(%{$merged{$domain}{$base}}); + if (@subbits > 1) { + push @addresses, "\Q$base\E(?:".join("|",@subbits).")"; + } else { + push @addresses, "\Q$base\E$subbits[0]"; + } + } + if (@addresses > 1) { + push @domains, "(?:".join("|", @addresses).")\Q\@".$domain."\E"; + } else { + push @domains, "$addresses[0]\Q\@$domain\E"; + } +} +my $re = join "|", @domains; + +print <<ENDDESCRIPTION; +You can add the following to RT_SiteConfig.pm, but may want to collapse it into a more efficient regexp. +Keep in mind that this only contains the email addresses that RT knows about, you should also examine +your mail system for aliases that reach RT but which RT doesn't know about. +ENDDESCRIPTION +print "Set(\$RTAddressRegexp,qr{^(?:${re})\$}i);\n"; + +sub merge { + my $merged = shift; + for my $address (grep {defined and length} @_) { + $address =~ /^\s*(.*?)(-comments?)?\@(.*?)\s*$/; + $merged->{lc $3}{$1}{$2||''}++; + } +} diff --git a/rt/etc/upgrade/split-out-cf-categories b/rt/etc/upgrade/split-out-cf-categories new file mode 100755 index 000000000..b61ade316 --- /dev/null +++ b/rt/etc/upgrade/split-out-cf-categories @@ -0,0 +1,171 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 lib "/opt/rt3/local/lib"; +use lib "/opt/rt3/lib"; + +use RT; +RT::LoadConfig(); +RT->Config->Set('LogToScreen' => 'debug'); +RT::Init(); + +$| = 1; + +$RT::Handle->BeginTransaction(); + +use RT::CustomFields; +my $CFs = RT::CustomFields->new( RT->SystemUser ); +$CFs->UnLimit; +$CFs->Limit( FIELD => 'Type', VALUE => 'Select' ); + +my $seen; +while (my $cf = $CFs->Next ) { + next if $cf->BasedOnObj->Id; + my @categories; + my %mapping; + my $values = $cf->Values; + while (my $value = $values->Next) { + next unless defined $value->Category and length $value->Category; + push @categories, $value->Category unless grep {$_ eq $value->Category} @categories; + $mapping{$value->Name} = $value->Category; + } + next unless @categories; + + $seen++; + print "Found CF '@{[$cf->Name]}' with categories:\n"; + print " $_\n" for @categories; + + print "Split this CF's categories into a hierarchical custom field (Y/n)? "; + my $dothis = <>; + next if $dothis =~ /n/i; + + print "Enter name of CF to create as category ('@{[$cf->Name]} category'): "; + my $newname = <>; + chomp $newname; + $newname = $cf->Name . " category" unless length $newname; + + # bump the CF's sort oder up by one + $cf->SetSortOrder( ($cf->SortOrder || 0) + 1 ); + + # ..and add a new CF before it + my $new = RT::CustomField->new( RT->SystemUser ); + my ($id, $msg) = $new->Create( + Name => $newname, + Type => 'Select', + MaxValues => 1, + LookupType => $cf->LookupType, + SortOrder => $cf->SortOrder - 1, + ); + die "Can't create custom field '$newname': $msg" unless $id; + + # Set the CF to be based on what we just made + $cf->SetBasedOn( $new->Id ); + + # Apply it to all of the same things + { + my $ocfs = RT::ObjectCustomFields->new( RT->SystemUser ); + $ocfs->LimitToCustomField( $cf->Id ); + while (my $ocf = $ocfs->Next) { + my $newocf = RT::ObjectCustomField->new( RT->SystemUser ); + ($id, $msg) = $newocf->Create( + SortOrder => $ocf->SortOrder, + CustomField => $new->Id, + ObjectId => $ocf->ObjectId, + ); + die "Can't create ObjectCustomField: $msg" unless $id; + } + } + + # Copy over all of the rights + { + my $acl = RT::ACL->new( RT->SystemUser ); + $acl->LimitToObject( $cf ); + while (my $ace = $acl->Next) { + my $newace = RT::ACE->new( RT->SystemUser ); + ($id, $msg) = $newace->Create( + PrincipalId => $ace->PrincipalId, + PrincipalType => $ace->PrincipalType, + RightName => $ace->RightName, + Object => $new, + ); + die "Can't assign rights: $msg" unless $id; + } + } + + # Add values for all of the categories + for my $i (0..$#categories) { + ($id, $msg) = $new->AddValue( + Name => $categories[$i], + SortOrder => $i + 1, + ); + die "Can't create custom field value: $msg" unless $id; + } + + # Grovel through all ObjectCustomFieldValues, and add the + # appropriate category + { + my $ocfvs = RT::ObjectCustomFieldValues->new( RT->SystemUser ); + $ocfvs->LimitToCustomField( $cf->Id ); + while (my $ocfv = $ocfvs->Next) { + next unless exists $mapping{$ocfv->Content}; + my $newocfv = RT::ObjectCustomFieldValue->new( RT->SystemUser ); + ($id, $msg) = $newocfv->Create( + CustomField => $new->Id, + ObjectType => $ocfv->ObjectType, + ObjectId => $ocfv->ObjectId, + Content => $mapping{$ocfv->Content}, + ); + } + } +} + +$RT::Handle->Commit; +print "No custom fields with categories found\n" unless $seen; diff --git a/rt/etc/upgrade/vulnerable-passwords b/rt/etc/upgrade/vulnerable-passwords new file mode 100755 index 000000000..7f278a0a7 --- /dev/null +++ b/rt/etc/upgrade/vulnerable-passwords @@ -0,0 +1,142 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 lib "/opt/rt3/local/lib"; +use lib "/opt/rt3/lib"; + +use RT; +RT::LoadConfig; +RT::Init; + +$| = 1; + +use Getopt::Long; +use Digest::SHA; +my $fix; +GetOptions("fix!" => \$fix); + +use RT::Users; +my $users = RT::Users->new( $RT::SystemUser ); +$users->Limit( + FIELD => 'Password', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'AND', +); +$users->Limit( + FIELD => 'Password', + OPERATOR => '!=', + VALUE => '*NO-PASSWORD*', + ENTRYAGGREGATOR => 'AND', +); +$users->Limit( + FIELD => 'Password', + OPERATOR => 'NOT STARTSWITH', + VALUE => '!', + ENTRYAGGREGATOR => 'AND', +); +push @{$users->{'restrictions'}{ "main.Password" }}, "AND", { + field => 'LENGTH(main.Password)', + op => '<', + value => '40', +}; + +# we want to update passwords on disabled users +$users->{'find_disabled_rows'} = 1; + +my $count = $users->Count; +if ($count == 0) { + print "No users with unsalted or weak cryptography found.\n"; + exit 0; +} + +if ($fix) { + print "Upgrading $count users...\n"; + while (my $u = $users->Next) { + my $stored = $u->__Value("Password"); + my $raw; + if (length $stored == 32) { + $raw = pack("H*",$stored); + } elsif (length $stored == 22) { + $raw = MIME::Base64::decode_base64($stored); + } elsif (length $stored == 13) { + printf "%20s => Old crypt() format, cannot upgrade\n", $u->Name; + } else { + printf "%20s => Unknown password format!\n", $u->Name; + } + next unless $raw; + + my $salt = pack("C4",map{int rand(256)} 1..4); + my $sha = Digest::SHA::sha256( + $salt . $raw + ); + $u->_Set( + Field => "Password", + Value => MIME::Base64::encode_base64( + $salt . substr($sha,0,26), ""), + ); + } + print "Done.\n"; + exit 0; +} else { + if ($count < 20) { + print "$count users found with unsalted or weak-cryptography passwords:\n"; + print " Id | Name\n", "-"x9, "+", "-"x9, "\n"; + while (my $u = $users->Next) { + printf "%8d | %s\n", $u->Id, $u->Name; + } + } else { + print "$count users found with unsalted or weak-cryptography passwords\n"; + } + + print "\n", "Run again with --fix to upgrade.\n"; + exit 1; +} diff --git a/rt/lib/.RT.pm.swp b/rt/lib/.RT.pm.swp Binary files differnew file mode 100644 index 000000000..55a25798e --- /dev/null +++ b/rt/lib/.RT.pm.swp diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm index e71d6c926..ec18caf51 100644 --- a/rt/lib/RT.pm +++ b/rt/lib/RT.pm @@ -52,6 +52,7 @@ use warnings; package RT; +use Encode (); use File::Spec (); use Cwd (); @@ -263,6 +264,9 @@ sub InitLogging { $frame++ while caller($frame) && caller($frame) =~ /^Log::/; my ($package, $filename, $line) = caller($frame); + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); + $p{'message'} =~ s/(?:\r*\n)+$//; return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " . $p{'message'} ." ($filename:$line)\n"; @@ -278,8 +282,8 @@ sub InitLogging { $frame++ while caller($frame) && caller($frame) =~ /^Log::/; my ($package, $filename, $line) = caller($frame); - # syswrite() cannot take utf8; turn it off here. - Encode::_utf8_off($p{message}); + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); $p{message} =~ s/(?:\r*\n)+$//; if ($p{level} eq 'debug') { @@ -382,19 +386,9 @@ sub InitSignalHandlers { ## mechanism (see above). $SIG{__WARN__} = sub { - # The 'wide character' warnings has to be silenced for now, at least - # until HTML::Mason offers a sane way to process both raw output and - # unicode strings. # use 'goto &foo' syntax to hide ANON sub from stack - if( index($_[0], 'Wide character in ') != 0 ) { - unshift @_, $RT::Logger, qw(level warning message); - goto &Log::Dispatch::log; - } - # Return value is used only by RT::Test to filter warnings from - # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever - # starts returning 'IGNORE', we'll need to switch to something more - # clever. I don't expect that to happen. - return 'IGNORE'; + unshift @_, $RT::Logger, qw(level warning message); + goto &Log::Dispatch::log; }; #When we call die, trap it and log->crit with the value of the die. diff --git a/rt/lib/RT.pm.orig b/rt/lib/RT.pm.orig new file mode 100644 index 000000000..e71d6c926 --- /dev/null +++ b/rt/lib/RT.pm.orig @@ -0,0 +1,887 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +package RT; + + +use File::Spec (); +use Cwd (); + +use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); + +use vars qw($BasePath + $EtcPath + $BinPath + $SbinPath + $VarPath + $LexiconPath + $PluginPath + $LocalPath + $LocalEtcPath + $LocalLibPath + $LocalLexiconPath + $LocalPluginPath + $MasonComponentRoot + $MasonLocalComponentRoot + $MasonDataDir + $MasonSessionDir); + + +RT->LoadGeneratedData(); + +=head1 NAME + +RT - Request Tracker + +=head1 SYNOPSIS + +A fully featured request tracker package. + +This documentation describes the point-of-entry for RT's Perl API. To learn +more about what RT is and what it can do for you, visit +L<https://bestpractical.com/rt>. + +=head1 DESCRIPTION + +=head2 INITIALIZATION + +If you're using RT's Perl libraries, you need to initialize RT before using any +of the modules. + +You have the option of handling the timing of config loading and the actual +init sequence yourself with: + + use RT; + BEGIN { + RT->LoadConfig; + RT->Init; + } + +or you can let RT do it all: + + use RT -init; + +This second method is particular useful when writing one-liners to interact with RT: + + perl -MRT=-init -e '...' + +The first method is necessary if you need to delay or conditionalize +initialization or if you want to fiddle with C<< RT->Config >> between loading +the config files and initializing the RT environment. + +=cut + +{ + my $DID_IMPORT_INIT; + sub import { + my $class = shift; + my $action = shift || ''; + + if ($action eq "-init" and not $DID_IMPORT_INIT) { + $class->LoadConfig; + $class->Init; + $DID_IMPORT_INIT = 1; + } + } +} + +=head2 LoadConfig + +Load RT's config file. First, the site configuration file +(F<RT_SiteConfig.pm>) is loaded, in order to establish overall site +settings like hostname and name of RT instance. Then, the core +configuration file (F<RT_Config.pm>) is loaded to set fallback values +for all settings; it bases some values on settings from the site +configuration file. + +In order for the core configuration to not override the site's +settings, the function C<Set> is used; it only sets values if they +have not been set already. + +=cut + +sub LoadConfig { + require RT::Config; + $Config = RT::Config->new; + $Config->LoadConfigs; + require RT::I18N; + + # RT::Essentials mistakenly recommends that WebPath be set to '/'. + # If the user does that, do what they mean. + $RT::WebPath = '' if ($RT::WebPath eq '/'); + + # fix relative LogDir and GnuPG homedir + unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) { + $Config->Set( LogDir => + File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) ); + } + + my $gpgopts = $Config->Get('GnuPGOptions'); + unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) { + $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} ); + } + + return $Config; +} + +=head2 Init + +L<Connects to the database|/ConnectToDatabase>, L<initilizes system +objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets +up logging|/InitLogging>, and L<loads plugins|/InitPlugins>. + +=cut + +sub Init { + shift if @_%2; # code is inconsistent about calling as method + my %args = (@_); + + CheckPerlRequirements(); + + InitPluginPaths(); + + #Get a database connection + ConnectToDatabase(); + InitSystemObjects(); + InitClasses(%args); + InitLogging(%args); + InitPlugins(); + RT::I18N->Init; + RT->Config->PostLoadCheck; + +} + +=head2 ConnectToDatabase + +Get a database connection. See also L</Handle>. + +=cut + +sub ConnectToDatabase { + require RT::Handle; + $Handle = RT::Handle->new unless $Handle; + $Handle->Connect; + return $Handle; +} + +=head2 InitLogging + +Create the Logger object and set up signal handlers. + +=cut + +sub InitLogging { + + my %arg = @_; + + # We have to set the record separator ($, man perlvar) + # or Log::Dispatch starts getting + # really pissy, as some other module we use unsets it. + $, = ''; + use Log::Dispatch 1.6; + + my %level_to_num = ( + map( { $_ => } 0..7 ), + debug => 0, + info => 1, + notice => 2, + warning => 3, + error => 4, 'err' => 4, + critical => 5, crit => 5, + alert => 6, + emergency => 7, emerg => 7, + ); + + unless ( $RT::Logger ) { + + $RT::Logger = Log::Dispatch->new; + + my $stack_from_level; + if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) { + # if option has old style '\d'(true) value + $stack_from_level = 0 if $stack_from_level =~ /^\d+$/; + $stack_from_level = $level_to_num{ $stack_from_level } || 0; + } else { + $stack_from_level = 99; # don't log + } + + my $simple_cb = sub { + # if this code throw any warning we can get segfault + no warnings; + my %p = @_; + + # skip Log::* stack frames + my $frame = 0; + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + my ($package, $filename, $line) = caller($frame); + + $p{'message'} =~ s/(?:\r*\n)+$//; + return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " + . $p{'message'} ." ($filename:$line)\n"; + }; + + my $syslog_cb = sub { + # if this code throw any warning we can get segfault + no warnings; + my %p = @_; + + my $frame = 0; # stack frame index + # skip Log::* stack frames + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + my ($package, $filename, $line) = caller($frame); + + # syswrite() cannot take utf8; turn it off here. + Encode::_utf8_off($p{message}); + + $p{message} =~ s/(?:\r*\n)+$//; + if ($p{level} eq 'debug') { + return "[$$] $p{message} ($filename:$line)\n"; + } else { + return "[$$] $p{message}\n"; + } + }; + + my $stack_cb = sub { + no warnings; + my %p = @_; + return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level; + + require Devel::StackTrace; + my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] ); + return $p{'message'} . $trace->as_string; + + # skip calling of the Log::* subroutins + my $frame = 0; + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/; + + $p{'message'} .= "\nStack trace:\n"; + while( my ($package, $filename, $line, $sub) = caller($frame++) ) { + $p{'message'} .= "\t$sub(...) called at $filename:$line\n"; + } + return $p{'message'}; + }; + + if ( $Config->Get('LogToFile') ) { + my ($filename, $logdir) = ( + $Config->Get('LogToFileNamed') || 'rt.log', + $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ), + ); + if ( $filename =~ m![/\\]! ) { # looks like an absolute path. + ($logdir) = $filename =~ m{^(.*[/\\])}; + } + else { + $filename = File::Spec->catfile( $logdir, $filename ); + } + + unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) { + # localizing here would be hard when we don't have a current user yet + die "Log file '$filename' couldn't be written or created.\n RT can't run."; + } + + require Log::Dispatch::File; + $RT::Logger->add( Log::Dispatch::File->new + ( name=>'file', + min_level=> $Config->Get('LogToFile'), + filename=> $filename, + mode=>'append', + callbacks => [ $simple_cb, $stack_cb ], + )); + } + if ( $Config->Get('LogToScreen') ) { + require Log::Dispatch::Screen; + $RT::Logger->add( Log::Dispatch::Screen->new + ( name => 'screen', + min_level => $Config->Get('LogToScreen'), + callbacks => [ $simple_cb, $stack_cb ], + stderr => 1, + )); + } + if ( $Config->Get('LogToSyslog') ) { + require Log::Dispatch::Syslog; + $RT::Logger->add(Log::Dispatch::Syslog->new + ( name => 'syslog', + ident => 'RT', + min_level => $Config->Get('LogToSyslog'), + callbacks => [ $syslog_cb, $stack_cb ], + stderr => 1, + $Config->Get('LogToSyslogConf'), + )); + } + } + InitSignalHandlers(%arg); +} + +{ # Work around bug in Log::Dispatch < 2.30, wherein the short forms + # of ->warn, ->err, and ->crit do not usefully propagate out, unlike + # ->warning, ->error, and ->critical + package Log::Dispatch; + no warnings 'redefine'; + sub warn { shift->warning(@_) } + sub err { shift->error(@_) } + sub crit { shift->critical(@_) } +} + +sub InitSignalHandlers { + + my %arg = @_; + return if $arg{'NoSignalHandlers'}; + +# Signal handlers +## This is the default handling of warnings and die'ings in the code +## (including other used modules - maybe except for errors catched by +## Mason). It will log all problems through the standard logging +## mechanism (see above). + + $SIG{__WARN__} = sub { + # The 'wide character' warnings has to be silenced for now, at least + # until HTML::Mason offers a sane way to process both raw output and + # unicode strings. + # use 'goto &foo' syntax to hide ANON sub from stack + if( index($_[0], 'Wide character in ') != 0 ) { + unshift @_, $RT::Logger, qw(level warning message); + goto &Log::Dispatch::log; + } + # Return value is used only by RT::Test to filter warnings from + # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever + # starts returning 'IGNORE', we'll need to switch to something more + # clever. I don't expect that to happen. + return 'IGNORE'; + }; + +#When we call die, trap it and log->crit with the value of the die. + + $SIG{__DIE__} = sub { + # if we are not in eval and perl is not parsing code + # then rollback transactions and log RT error + unless ($^S || !defined $^S ) { + $RT::Handle->Rollback(1) if $RT::Handle; + $RT::Logger->crit("$_[0]") if $RT::Logger; + } + die $_[0]; + }; +} + + +sub CheckPerlRequirements { + if ($^V < 5.008003) { + die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; + } + + # use $error here so the following "die" can still affect the global $@ + my $error; + { + local $@; + eval { + my $x = ''; + my $y = \$x; + require Scalar::Util; + Scalar::Util::weaken($y); + }; + $error = $@; + } + + if ($error) { + die <<"EOF"; + +RT requires the Scalar::Util module be built with support for the 'weaken' +function. + +It is sometimes the case that operating system upgrades will replace +a working Scalar::Util with a non-working one. If your system was working +correctly up until now, this is likely the cause of the problem. + +Please reinstall Scalar::Util, being careful to let it build with your C +compiler. Usually this is as simple as running the following command as +root. + + perl -MCPAN -e'install Scalar::Util' + +EOF + + } +} + +=head2 InitClasses + +Load all modules that define base classes. + +=cut + +sub InitClasses { + shift if @_%2; # so we can call it as a function or method + my %args = (@_); + require RT::Tickets; + require RT::Transactions; + require RT::Attachments; + require RT::Users; + require RT::Principals; + require RT::CurrentUser; + require RT::Templates; + require RT::Queues; + require RT::ScripActions; + require RT::ScripConditions; + require RT::Scrips; + require RT::Groups; + require RT::GroupMembers; + require RT::CustomFields; + require RT::CustomFieldValues; + require RT::ObjectCustomFields; + require RT::ObjectCustomFieldValues; + require RT::Attributes; + require RT::Dashboard; + require RT::Approval; + require RT::Lifecycle; + require RT::Link; + require RT::Links; + require RT::Article; + require RT::Articles; + require RT::Class; + require RT::Classes; + require RT::ObjectClass; + require RT::ObjectClasses; + require RT::ObjectTopic; + require RT::ObjectTopics; + require RT::Topic; + require RT::Topics; + + # on a cold server (just after restart) people could have an object + # in the session, as we deserialize it so we never call constructor + # of the class, so the list of accessible fields is empty and we die + # with "Method xxx is not implemented in RT::SomeClass" + + # without this, we also can never call _ClassAccessible, because we + # won't have filled RT::Record::_TABLE_ATTR + $_->_BuildTableAttributes foreach qw( + RT::Ticket + RT::Transaction + RT::Attachment + RT::User + RT::Principal + RT::Template + RT::Queue + RT::ScripAction + RT::ScripCondition + RT::Scrip + RT::Group + RT::GroupMember + RT::CustomField + RT::CustomFieldValue + RT::ObjectCustomField + RT::ObjectCustomFieldValue + RT::Attribute + RT::ACE + RT::Link + RT::Article + RT::Class + RT::ObjectClass + RT::ObjectTopic + RT::Topic + ); + + if ( $args{'Heavy'} ) { + # load scrips' modules + my $scrips = RT::Scrips->new(RT->SystemUser); + $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' ); + while ( my $scrip = $scrips->Next ) { + local $@; + eval { $scrip->LoadModules } or + $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". + "You should delete or repair this Scrip in the admin UI.\n$@\n"); + } + + foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { + local $@; + eval "require $class; 1" or $RT::Logger->error( + "Class '$class' is listed in CustomFieldValuesSources option" + ." in the config, but we failed to load it:\n$@\n" + ); + } + + } +} + +=head2 InitSystemObjects + +Initializes system objects: C<$RT::System>, C<< RT->SystemUser >> +and C<< RT->Nobody >>. + +=cut + +sub InitSystemObjects { + + #RT's system user is a genuine database user. its id lives here + require RT::CurrentUser; + $SystemUser = RT::CurrentUser->new; + $SystemUser->LoadByName('RT_System'); + + #RT's "nobody user" is a genuine database user. its ID lives here. + $Nobody = RT::CurrentUser->new; + $Nobody->LoadByName('Nobody'); + + require RT::System; + $System = RT::System->new( $SystemUser ); +} + +=head1 CLASS METHODS + +=head2 Config + +Returns the current L<config object|RT::Config>, but note that +you must L<load config|/LoadConfig> first otherwise this method +returns undef. + +Method can be called as class method. + +=cut + +sub Config { return $Config || shift->LoadConfig(); } + +=head2 DatabaseHandle + +Returns the current L<database handle object|RT::Handle>. + +See also L</ConnectToDatabase>. + +=cut + +sub DatabaseHandle { return $Handle } + +=head2 Logger + +Returns the logger. See also L</InitLogging>. + +=cut + +sub Logger { return $Logger } + +=head2 System + +Returns the current L<system object|RT::System>. See also +L</InitSystemObjects>. + +=cut + +sub System { return $System } + +=head2 SystemUser + +Returns the system user's object, it's object of +L<RT::CurrentUser> class that represents the system. See also +L</InitSystemObjects>. + +=cut + +sub SystemUser { return $SystemUser } + +=head2 Nobody + +Returns object of Nobody. It's object of L<RT::CurrentUser> class +that represents a user who can own ticket and nothing else. See +also L</InitSystemObjects>. + +=cut + +sub Nobody { return $Nobody } + +sub PrivilegedUsers { + if (!$_Privileged) { + $_Privileged = RT::Group->new(RT->SystemUser); + $_Privileged->LoadSystemInternalGroup('Privileged'); + } + return $_Privileged; +} + +sub UnprivilegedUsers { + if (!$_Unprivileged) { + $_Unprivileged = RT::Group->new(RT->SystemUser); + $_Unprivileged->LoadSystemInternalGroup('Unprivileged'); + } + return $_Unprivileged; +} + + +=head2 Plugins + +Returns a listref of all Plugins currently configured for this RT instance. +You can define plugins by adding them to the @Plugins list in your RT_SiteConfig + +=cut + +our @PLUGINS = (); +sub Plugins { + my $self = shift; + unless (@PLUGINS) { + $self->InitPluginPaths; + @PLUGINS = $self->InitPlugins; + } + return \@PLUGINS; +} + +=head2 PluginDirs + +Takes an optional subdir (e.g. po, lib, etc.) and returns a list of +directories from plugins where that subdirectory exists. + +This code does not check plugin names, plugin validitity, or load +plugins (see L</InitPlugins>) in any way, and requires that RT's +configuration have been already loaded. + +=cut + +sub PluginDirs { + my $self = shift; + my $subdir = shift; + + require RT::Plugin; + + my @res; + foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { + my $path = RT::Plugin->new( name => $plugin )->Path( $subdir ); + next unless -d $path; + push @res, $path; + } + return @res; +} + +=head2 InitPluginPaths + +Push plugins' lib paths into @INC right after F<local/lib>. +In case F<local/lib> isn't in @INC, append them to @INC + +=cut + +sub InitPluginPaths { + my $self = shift || __PACKAGE__; + + my @lib_dirs = $self->PluginDirs('lib'); + + my @tmp_inc; + my $added; + for (@INC) { + my $realpath = Cwd::realpath($_); + next unless defined $realpath; + if ( $realpath eq $RT::LocalLibPath) { + push @tmp_inc, $_, @lib_dirs; + $added = 1; + } else { + push @tmp_inc, $_; + } + } + + # append @lib_dirs in case $RT::LocalLibPath isn't in @INC + push @tmp_inc, @lib_dirs unless $added; + + my %seen; + @INC = grep !$seen{$_}++, @tmp_inc; +} + +=head2 InitPlugins + +Initialize all Plugins found in the RT configuration file, setting up +their lib and L<HTML::Mason> component roots. + +=cut + +sub InitPlugins { + my $self = shift; + my @plugins; + require RT::Plugin; + foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { + $plugin->require; + die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR); + push @plugins, RT::Plugin->new(name =>$plugin); + } + return @plugins; +} + + +sub InstallMode { + my $self = shift; + if (@_) { + my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + if ($_[0] and $integrity) { + # Trying to turn install mode on but we have a good DB! + require Carp; + $RT::Logger->error( + Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!") + ); + } + else { + $_INSTALL_MODE = shift; + if($_INSTALL_MODE) { + require RT::CurrentUser; + $SystemUser = RT::CurrentUser->new(); + } + } + } + return $_INSTALL_MODE; +} + +sub LoadGeneratedData { + my $class = shift; + my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + + require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@"; + $class->CanonicalizeGeneratedPaths(); +} + +sub CanonicalizeGeneratedPaths { + my $class = shift; + unless ( File::Spec->file_name_is_absolute($EtcPath) ) { + + # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}. + # otherwise RT.pm will make the source dir(where we configure RT) be the + # BasePath instead of the one specified by --prefix + unless ( -d $BasePath + && File::Spec->file_name_is_absolute($BasePath) ) + { + my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + + # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'} + # is not always absolute + $BasePath = File::Spec->rel2abs( + File::Spec->catdir( $pm_path, File::Spec->updir ) ); + } + + $BasePath = Cwd::realpath($BasePath); + + for my $path ( + qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath + LocalLibPath LexiconPath LocalLexiconPath PluginPath + LocalPluginPath MasonComponentRoot MasonLocalComponentRoot + MasonDataDir MasonSessionDir/ + ) + { + no strict 'refs'; + + # just change relative ones + $$path = File::Spec->catfile( $BasePath, $$path ) + unless File::Spec->file_name_is_absolute($$path); + } + } + +} + +=head2 AddJavaScript + +helper method to add js files to C<JSFiles> config. +to add extra js files, you can add the following line +in the plugin's main file: + + RT->AddJavaScript( 'foo.js', 'bar.js' ); + +=cut + +sub AddJavaScript { + my $self = shift; + + my @old = RT->Config->Get('JSFiles'); + RT->Config->Set( 'JSFiles', @old, @_ ); + return RT->Config->Get('JSFiles'); +} + +=head2 AddStyleSheets + +helper method to add css files to C<CSSFiles> config + +to add extra css files, you can add the following line +in the plugin's main file: + + RT->AddStyleSheets( 'foo.css', 'bar.css' ); + +=cut + +sub AddStyleSheets { + my $self = shift; + my @old = RT->Config->Get('CSSFiles'); + RT->Config->Set( 'CSSFiles', @old, @_ ); + return RT->Config->Get('CSSFiles'); +} + +=head2 JavaScript + +helper method of RT->Config->Get('JSFiles') + +=cut + +sub JavaScript { + return RT->Config->Get('JSFiles'); +} + +=head2 StyleSheets + +helper method of RT->Config->Get('CSSFiles') + +=cut + +sub StyleSheets { + return RT->Config->Get('CSSFiles'); +} + +=head1 BUGS + +Please report them to rt-bugs@bestpractical.com, if you know what's +broken and have at least some idea of what needs to be fixed. + +If you're not sure what's going on, report them rt-devel@lists.bestpractical.com. + +=head1 SEE ALSO + +L<RT::StyleGuide> +L<DBIx::SearchBuilder> + +=cut + +require RT::Base; +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/.Handle.pm.swp b/rt/lib/RT/.Handle.pm.swp Binary files differnew file mode 100644 index 000000000..5ae85734d --- /dev/null +++ b/rt/lib/RT/.Handle.pm.swp diff --git a/rt/lib/RT/.Ticket.pm.swp b/rt/lib/RT/.Ticket.pm.swp Binary files differnew file mode 100644 index 000000000..7088d1bcf --- /dev/null +++ b/rt/lib/RT/.Ticket.pm.swp diff --git a/rt/lib/RT/Action/CreateTickets.pm b/rt/lib/RT/Action/CreateTickets.pm index e3c7b53e0..542cbd27b 100644 --- a/rt/lib/RT/Action/CreateTickets.pm +++ b/rt/lib/RT/Action/CreateTickets.pm @@ -579,15 +579,11 @@ sub _ParseMultilineTemplate { my %args = (@_); my $template_id; - require Encode; - require utf8; my ( $queue, $requestor ); $RT::Logger->debug("Line: ==="); foreach my $line ( split( /\n/, $args{'Content'} ) ) { $line =~ s/\r$//; - $RT::Logger->debug( "Line: " . utf8::is_utf8($line) - ? Encode::encode_utf8($line) - : $line ); + $RT::Logger->debug( "Line: $line" ); if ( $line =~ /^===/ ) { if ( $template_id && !$queue && $args{'Queue'} ) { $self->{'templates'}->{$template_id} @@ -790,10 +786,10 @@ sub ParseLines { ); if ( $args{content} ) { - my $mimeobj = MIME::Entity->new(); - $mimeobj->build( - Type => $args{'contenttype'} || 'text/plain', - Data => $args{'content'} + my $mimeobj = MIME::Entity->build( + Type => $args{'contenttype'} || 'text/plain', + Charset => 'UTF-8', + Data => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ], ); $ticketargs{MIMEObj} = $mimeobj; $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond'; diff --git a/rt/lib/RT/Action/CreateTickets.pm.orig b/rt/lib/RT/Action/CreateTickets.pm.orig new file mode 100644 index 000000000..e3c7b53e0 --- /dev/null +++ b/rt/lib/RT/Action/CreateTickets.pm.orig @@ -0,0 +1,1292 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +package RT::Action::CreateTickets; +use base 'RT::Action'; + +use strict; +use warnings; + +use MIME::Entity; + +=head1 NAME + +RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template + +=head1 SYNOPSIS + + ===Create-Ticket: codereview + Subject: Code review for {$Tickets{'TOP'}->Subject} + Depended-On-By: TOP + Content: Someone has created a ticket. you should review and approve it, + so they can finish their work + ENDOFCONTENT + +=head1 DESCRIPTION + +The CreateTickets ScripAction allows you to create automated workflows in RT, +creating new tickets in response to actions and conditions from other +tickets. + +=head2 Format + +CreateTickets uses the RT template configured in the scrip as a template +for an ordered set of tickets to create. The basic format is as follows: + + ===Create-Ticket: identifier + Param: Value + Param2: Value + Param3: Value + Content: Blah + blah + blah + ENDOFCONTENT + ===Create-Ticket: id2 + Param: Value + Content: Blah + ENDOFCONTENT + +As shown, you can put one or more C<===Create-Ticket:> sections in +a template. Each C<===Create-Ticket:> section is evaluated as its own +L<Text::Template> object, which means that you can embed snippets +of Perl inside the L<Text::Template> using C<{}> delimiters, but that +such sections absolutely can not span a C<===Create-Ticket:> boundary. + +Note that each C<Value> must come right after the C<Param> on the same +line. The C<Content:> param can extend over multiple lines, but the text +of the first line must start right after C<Content:>. Don't try to start +your C<Content:> section with a newline. + +After each ticket is created, it's stuffed into a hash called C<%Tickets> +making it available during the creation of other tickets during the +same ScripAction. The hash key for each ticket is C<create-[identifier]>, +where C<[identifier]> is the value you put after C<===Create-Ticket:>. The hash +is prepopulated with the ticket which triggered the ScripAction as +C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand +C<TOP>. + +A simple example: + + ===Create-Ticket: codereview + Subject: Code review for {$Tickets{'TOP'}->Subject} + Depended-On-By: TOP + Content: Someone has created a ticket. you should review and approve it, + so they can finish their work + ENDOFCONTENT + +A convoluted example: + + ===Create-Ticket: approval + { # Find out who the administrators of the group called "HR" + # of which the creator of this ticket is a member + my $name = "HR"; + + my $groups = RT::Groups->new(RT->SystemUser); + $groups->LimitToUserDefinedGroups(); + $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name"); + $groups->WithMember($TransactionObj->CreatorObj->Id); + + my $groupid = $groups->First->Id; + + my $adminccs = RT::Users->new(RT->SystemUser); + $adminccs->WhoHaveRight( + Right => "AdminGroup", + Object =>$groups->First, + IncludeSystemRights => undef, + IncludeSuperusers => 0, + IncludeSubgroupMembers => 0, + ); + + our @admins; + while (my $admin = $adminccs->Next) { + push (@admins, $admin->EmailAddress); + } + } + Queue: ___Approvals + Type: approval + AdminCc: {join ("\nAdminCc: ",@admins) } + Depended-On-By: TOP + Refers-To: TOP + Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject} + Due: {time + 86400} + Content-Type: text/plain + Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject} + Blah + Blah + ENDOFCONTENT + ===Create-Ticket: two + Subject: Manager approval + Type: approval + Depended-On-By: TOP + Refers-To: {$Tickets{"create-approval"}->Id} + Queue: ___Approvals + Content-Type: text/plain + Content: Your approval is requred for this ticket, too. + ENDOFCONTENT + +As shown above, you can include a block with Perl code to set up some +values for the new tickets. If you want to access a variable in the +template section after the block, you must scope it with C<our> rather +than C<my>. Just as with other RT templates, you can also include +Perl code in the template sections using C<{}>. + +=head2 Acceptable Fields + +A complete list of acceptable fields: + + * Queue => Name or id# of a queue + Subject => A text string + ! Status => A valid status. Defaults to 'new' + Due => Dates can be specified in seconds since the epoch + to be handled literally or in a semi-free textual + format which RT will attempt to parse. + Starts => + Started => + Resolved => + Owner => Username or id of an RT user who can and should own + this ticket; forces the owner if necessary + + Requestor => Email address + + Cc => Email address + + AdminCc => Email address + + RequestorGroup => Group name + + CcGroup => Group name + + AdminCcGroup => Group name + TimeWorked => + TimeEstimated => + TimeLeft => + InitialPriority => + FinalPriority => + Type => + +! DependsOn => + +! DependedOnBy => + +! RefersTo => + +! ReferredToBy => + +! Members => + +! MemberOf => + Content => Content. Can extend to multiple lines. Everything + within a template after a Content: header is treated + as content until we hit a line containing only + ENDOFCONTENT + ContentType => the content-type of the Content field. Defaults to + 'text/plain' + UpdateType => 'correspond' or 'comment'; used in conjunction with + 'content' if this is an update. Defaults to + 'correspond' + + CustomField-<id#> => custom field value + CF-name => custom field value + CustomField-name => custom field value + +Fields marked with an C<*> are required. + +Fields marked with a C<+> may have multiple values, simply +by repeating the fieldname on a new line with an additional value. + +Fields marked with a C<!> have processing postponed until after all +tickets in the same actions are created. Except for C<Status>, those +fields can also take a ticket name within the same action (i.e. +the identifiers after C<===Create-Ticket:>), instead of raw ticket ID +numbers. + +When parsed, field names are converted to lowercase and have hyphens stripped. +C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will +all be treated as the same thing. + +=head1 METHODS + +=cut + +my %LINKTYPEMAP = ( + MemberOf => { + Type => 'MemberOf', + Mode => 'Target', + }, + Parents => { + Type => 'MemberOf', + Mode => 'Target', + }, + Members => { + Type => 'MemberOf', + Mode => 'Base', + }, + Children => { + Type => 'MemberOf', + Mode => 'Base', + }, + HasMember => { + Type => 'MemberOf', + Mode => 'Base', + }, + RefersTo => { + Type => 'RefersTo', + Mode => 'Target', + }, + ReferredToBy => { + Type => 'RefersTo', + Mode => 'Base', + }, + DependsOn => { + Type => 'DependsOn', + Mode => 'Target', + }, + DependedOnBy => { + Type => 'DependsOn', + Mode => 'Base', + }, + +); + + +#Do what we need to do and send it out. +sub Commit { + my $self = shift; + + # Create all the tickets we care about + return (1) unless $self->TicketObj->Type eq 'ticket'; + + $self->CreateByTemplate( $self->TicketObj ); + $self->UpdateByTemplate( $self->TicketObj ); + return (1); +} + + + +sub Prepare { + my $self = shift; + + unless ( $self->TemplateObj ) { + $RT::Logger->warning("No template object handed to $self"); + } + + unless ( $self->TransactionObj ) { + $RT::Logger->warning("No transaction object handed to $self"); + + } + + unless ( $self->TicketObj ) { + $RT::Logger->warning("No ticket object handed to $self"); + + } + + my $active = 0; + if ( $self->TemplateObj->Type eq 'Perl' ) { + $active = 1; + } else { + RT->Logger->info(sprintf( + "Template #%d is type %s. You most likely want to use a Perl template instead.", + $self->TemplateObj->id, $self->TemplateObj->Type + )); + } + + $self->Parse( + Content => $self->TemplateObj->Content, + _ActiveContent => $active, + ); + return 1; + +} + + + +sub CreateByTemplate { + my $self = shift; + my $top = shift; + + $RT::Logger->debug("In CreateByTemplate"); + + my @results; + + # XXX: cargo cult programming that works. i'll be back. + + local %T::Tickets = %T::Tickets; + local $T::TOP = $T::TOP; + local $T::ID = $T::ID; + $T::Tickets{'TOP'} = $T::TOP = $top if $top; + local $T::TransactionObj = $self->TransactionObj; + + my $ticketargs; + my ( @links, @postponed ); + foreach my $template_id ( @{ $self->{'create_tickets'} } ) { + $RT::Logger->debug("Workflow: processing $template_id of $T::TOP") + if $T::TOP; + + $T::ID = $template_id; + @T::AllID = @{ $self->{'create_tickets'} }; + + ( $T::Tickets{$template_id}, $ticketargs ) + = $self->ParseLines( $template_id, \@links, \@postponed ); + + # Now we have a %args to work with. + # Make sure we have at least the minimum set of + # reasonable data and do our thang + + my ( $id, $transid, $msg ) + = $T::Tickets{$template_id}->Create(%$ticketargs); + + foreach my $res ( split( '\n', $msg ) ) { + push @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': ' + . $res; + } + if ( !$id ) { + if ( $self->TicketObj ) { + $msg = "Couldn't create related ticket $template_id for " + . $self->TicketObj->Id . " " + . $msg; + } else { + $msg = "Couldn't create ticket $template_id " . $msg; + } + + $RT::Logger->error($msg); + next; + } + + $RT::Logger->debug("Assigned $template_id with $id"); + $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj ) + if $self->TicketObj + && $T::Tickets{$template_id}->can('SetOriginObj'); + + } + + $self->PostProcess( \@links, \@postponed ); + + return @results; +} + +sub UpdateByTemplate { + my $self = shift; + my $top = shift; + + # XXX: cargo cult programming that works. i'll be back. + + my @results; + local %T::Tickets = %T::Tickets; + local $T::ID = $T::ID; + + my $ticketargs; + my ( @links, @postponed ); + foreach my $template_id ( @{ $self->{'update_tickets'} } ) { + $RT::Logger->debug("Update Workflow: processing $template_id"); + + $T::ID = $template_id; + @T::AllID = @{ $self->{'update_tickets'} }; + + ( $T::Tickets{$template_id}, $ticketargs ) + = $self->ParseLines( $template_id, \@links, \@postponed ); + + # Now we have a %args to work with. + # Make sure we have at least the minimum set of + # reasonable data and do our thang + + my @attribs = qw( + Subject + FinalPriority + Priority + TimeEstimated + TimeWorked + TimeLeft + Status + Queue + Due + Starts + Started + Resolved + ); + + my $id = $template_id; + $id =~ s/update-(\d+).*/$1/; + my ($loaded, $msg) = $T::Tickets{$template_id}->LoadById($id); + + unless ( $loaded ) { + $RT::Logger->error("Couldn't update ticket $template_id: " . $msg); + push @results, $self->loc( "Couldn't load ticket '[_1]'", $id ); + next; + } + + my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} ); + + $template_id =~ m/^update-(.*)/; + my $base_id = "base-$1"; + my $base = $self->{'templates'}->{$base_id}; + if ($base) { + $base =~ s/\r//g; + $base =~ s/\n+$//; + $current =~ s/\n+$//; + + # If we have no base template, set what we can. + if ( $base ne $current ) { + push @results, + "Could not update ticket " + . $T::Tickets{$template_id}->Id + . ": Ticket has changed"; + next; + } + } + push @results, $T::Tickets{$template_id}->Update( + AttributesRef => \@attribs, + ARGSRef => $ticketargs + ); + + if ( $ticketargs->{'Owner'} ) { + ($id, $msg) = $T::Tickets{$template_id}->SetOwner($ticketargs->{'Owner'}, "Force"); + push @results, $msg unless $msg eq $self->loc("That user already owns that ticket"); + } + + push @results, + $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs ); + + push @results, + $self->UpdateCustomFields( $T::Tickets{$template_id}, $ticketargs ); + + next unless $ticketargs->{'MIMEObj'}; + if ( $ticketargs->{'UpdateType'} =~ /^(private|comment)$/i ) { + my ( $Transaction, $Description, $Object ) + = $T::Tickets{$template_id}->Comment( + BccMessageTo => $ticketargs->{'Bcc'}, + MIMEObj => $ticketargs->{'MIMEObj'}, + TimeTaken => $ticketargs->{'TimeWorked'} + ); + push( @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) + . ': ' + . $Description ); + } elsif ( $ticketargs->{'UpdateType'} =~ /^(public|response|correspond)$/i ) { + my ( $Transaction, $Description, $Object ) + = $T::Tickets{$template_id}->Correspond( + BccMessageTo => $ticketargs->{'Bcc'}, + MIMEObj => $ticketargs->{'MIMEObj'}, + TimeTaken => $ticketargs->{'TimeWorked'} + ); + push( @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) + . ': ' + . $Description ); + } else { + push( + @results, + $T::Tickets{$template_id}->loc( + "Update type was neither correspondence nor comment.") + . " " + . $T::Tickets{$template_id}->loc("Update not recorded.") + ); + } + } + + $self->PostProcess( \@links, \@postponed ); + + return @results; +} + +=head2 Parse + +Takes (in order) template content, a default queue, a default requestor, and +active (a boolean flag). + +Parses a template in the template content, defaulting queue and requestor if +unspecified in the template to the values provided as arguments. + +If the active flag is true, then we'll use L<Text::Template> to parse the +templates, allowing you to embed active Perl in your templates. + +=cut + +sub Parse { + my $self = shift; + my %args = ( + Content => undef, + Queue => undef, + Requestor => undef, + _ActiveContent => undef, + @_ + ); + + if ( $args{'_ActiveContent'} ) { + $self->{'UsePerlTextTemplate'} = 1; + } else { + + $self->{'UsePerlTextTemplate'} = 0; + } + + if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) { + $self->_ParseMultilineTemplate(%args); + } elsif ( $args{'Content'} =~ /(?:\t|,)/i ) { + $self->_ParseXSVTemplate(%args); + } else { + RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}"); + } +} + +=head2 _ParseMultilineTemplate + +Parses mulitline templates. Things like: + + ===Create-Ticket: ... + +Takes the same arguments as L</Parse>. + +=cut + +sub _ParseMultilineTemplate { + my $self = shift; + my %args = (@_); + + my $template_id; + require Encode; + require utf8; + my ( $queue, $requestor ); + $RT::Logger->debug("Line: ==="); + foreach my $line ( split( /\n/, $args{'Content'} ) ) { + $line =~ s/\r$//; + $RT::Logger->debug( "Line: " . utf8::is_utf8($line) + ? Encode::encode_utf8($line) + : $line ); + if ( $line =~ /^===/ ) { + if ( $template_id && !$queue && $args{'Queue'} ) { + $self->{'templates'}->{$template_id} + .= "Queue: $args{'Queue'}\n"; + } + if ( $template_id && !$requestor && $args{'Requestor'} ) { + $self->{'templates'}->{$template_id} + .= "Requestor: $args{'Requestor'}\n"; + } + $queue = 0; + $requestor = 0; + } + if ( $line =~ /^===Create-Ticket: (.*)$/ ) { + $template_id = "create-$1"; + $RT::Logger->debug("**** Create ticket: $template_id"); + push @{ $self->{'create_tickets'} }, $template_id; + } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) { + $template_id = "update-$1"; + $RT::Logger->debug("**** Update ticket: $template_id"); + push @{ $self->{'update_tickets'} }, $template_id; + } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) { + $template_id = "base-$1"; + $RT::Logger->debug("**** Base ticket: $template_id"); + push @{ $self->{'base_tickets'} }, $template_id; + } elsif ( $line =~ /^===#.*$/ ) { # a comment + next; + } else { + if ( $line =~ /^Queue:(.*)/i ) { + $queue = 1; + my $value = $1; + $value =~ s/^\s//; + $value =~ s/\s$//; + if ( !$value && $args{'Queue'} ) { + $value = $args{'Queue'}; + $line = "Queue: $value"; + } + } + if ( $line =~ /^Requestors?:(.*)/i ) { + $requestor = 1; + my $value = $1; + $value =~ s/^\s//; + $value =~ s/\s$//; + if ( !$value && $args{'Requestor'} ) { + $value = $args{'Requestor'}; + $line = "Requestor: $value"; + } + } + $self->{'templates'}->{$template_id} .= $line . "\n"; + } + } + if ( $template_id && !$queue && $args{'Queue'} ) { + $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n"; + } + } + +sub ParseLines { + my $self = shift; + my $template_id = shift; + my $links = shift; + my $postponed = shift; + + my $content = $self->{'templates'}->{$template_id}; + + if ( $self->{'UsePerlTextTemplate'} ) { + + $RT::Logger->debug( + "Workflow: evaluating\n$self->{templates}{$template_id}"); + + my $template = Text::Template->new( + TYPE => 'STRING', + SOURCE => $content + ); + + my $err; + $content = $template->fill_in( + PACKAGE => 'T', + BROKEN => sub { + $err = {@_}->{error}; + } + ); + + $RT::Logger->debug("Workflow: yielding $content"); + + if ($err) { + $RT::Logger->error( "Ticket creation failed: " . $err ); + while ( my ( $k, $v ) = each %T::X ) { + $RT::Logger->debug( + "Eliminating $template_id from ${k}'s parents."); + delete $v->{$template_id}; + } + next; + } + } + + my $TicketObj ||= RT::Ticket->new( $self->CurrentUser ); + + my %args; + my %original_tags; + my @lines = ( split( /\n/, $content ) ); + while ( defined( my $line = shift @lines ) ) { + if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) { + my $value = $2; + my $original_tag = $1; + my $tag = lc($original_tag); + $tag =~ s/-//g; + $tag =~ s/^(requestor|cc|admincc)s?$/$1/i; + + $original_tags{$tag} = $original_tag; + + if ( ref( $args{$tag} ) ) + { #If it's an array, we want to push the value + push @{ $args{$tag} }, $value; + } elsif ( defined( $args{$tag} ) ) + { #if we're about to get a second value, make it an array + $args{$tag} = [ $args{$tag}, $value ]; + } else { #if there's nothing there, just set the value + $args{$tag} = $value; + } + + if ( $tag =~ /^content$/i ) { #just build up the content + # convert it to an array + $args{$tag} = defined($value) ? [ $value . "\n" ] : []; + while ( defined( my $l = shift @lines ) ) { + last if ( $l =~ /^ENDOFCONTENT\s*$/ ); + push @{ $args{'content'} }, $l . "\n"; + } + } else { + # if it's not content, strip leading and trailing spaces + if ( $args{$tag} ) { + $args{$tag} =~ s/^\s+//g; + $args{$tag} =~ s/\s+$//g; + } + if ( + ($tag =~ /^(requestor|cc|admincc)(group)?$/i + or grep {lc $_ eq $tag} keys %LINKTYPEMAP) + and $args{$tag} =~ /,/ + ) { + $args{$tag} = [ split /,\s*/, $args{$tag} ]; + } + } + } + } + + foreach my $date (qw(due starts started resolved)) { + my $dateobj = RT::Date->new( $self->CurrentUser ); + next unless $args{$date}; + if ( $args{$date} =~ /^\d+$/ ) { + $dateobj->Set( Format => 'unix', Value => $args{$date} ); + } else { + eval { + $dateobj->Set( Format => 'iso', Value => $args{$date} ); + }; + if ($@ or $dateobj->Unix <= 0) { + $dateobj->Set( Format => 'unknown', Value => $args{$date} ); + } + } + $args{$date} = $dateobj->ISO; + } + + foreach my $role (qw(requestor cc admincc)) { + next unless my $value = $args{ $role . 'group' }; + + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadUserDefinedGroup( $value ); + unless ( $group->id ) { + $RT::Logger->error("Couldn't load group '$value'"); + next; + } + + $args{ $role } = $args{ $role } ? [$args{ $role }] : [] + unless ref $args{ $role }; + push @{ $args{ $role } }, $group->PrincipalObj->id; + } + + $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses + if $self->TicketObj; + + $args{'type'} ||= 'ticket'; + + my %ticketargs = ( + Queue => $args{'queue'}, + Subject => $args{'subject'}, + Status => $args{'status'} || 'new', + Due => $args{'due'}, + Starts => $args{'starts'}, + Started => $args{'started'}, + Resolved => $args{'resolved'}, + Owner => $args{'owner'}, + Requestor => $args{'requestor'}, + Cc => $args{'cc'}, + AdminCc => $args{'admincc'}, + TimeWorked => $args{'timeworked'}, + TimeEstimated => $args{'timeestimated'}, + TimeLeft => $args{'timeleft'}, + InitialPriority => $args{'initialpriority'} || 0, + FinalPriority => $args{'finalpriority'} || 0, + SquelchMailTo => $args{'squelchmailto'}, + Type => $args{'type'}, + $self->Rules + ); + + if ( $args{content} ) { + my $mimeobj = MIME::Entity->new(); + $mimeobj->build( + Type => $args{'contenttype'} || 'text/plain', + Data => $args{'content'} + ); + $ticketargs{MIMEObj} = $mimeobj; + $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond'; + } + + foreach my $tag ( keys(%args) ) { + # if the tag was added later, skip it + my $orig_tag = $original_tags{$tag} or next; + if ( $orig_tag =~ /^customfield-?(\d+)$/i ) { + $ticketargs{ "CustomField-" . $1 } = $args{$tag}; + } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) { + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} ); + $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id; + next unless $cf->id; + $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; + } elsif ($orig_tag) { + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} ); + $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id; + next unless $cf->id; + $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; + + } + } + + $self->GetDeferred( \%args, $template_id, $links, $postponed ); + + return $TicketObj, \%ticketargs; +} + + +=head2 _ParseXSVTemplate + +Parses a tab or comma delimited template. Should only ever be called by +L</Parse>. + +=cut + +sub _ParseXSVTemplate { + my $self = shift; + my %args = (@_); + + use Regexp::Common qw(delimited); + my($first, $content) = split(/\r?\n/, $args{'Content'}, 2); + + my $delimiter; + if ( $first =~ /\t/ ) { + $delimiter = "\t"; + } else { + $delimiter = ','; + } + my @fields = split( /$delimiter/, $first ); + + my $delimiter_re = qr[$delimiter]; + my $justquoted = qr[$RE{quoted}]; + + # Used to generate automatic template ids + my $autoid = 1; + + LINE: + while ($content) { + $content =~ s/^(\s*\r?\n)+//; + + # Keep track of Queue and Requestor, so we can provide defaults + my $queue; + my $requestor; + + # The template for this line + my $template; + + # What column we're on + my $i = 0; + + # If the last iteration was the end of the line + my $EOL = 0; + + # The template id + my $template_id; + + COLUMN: + while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) { + $EOL = not $2; + + # Strip off quotes, if they exist + my $value = $1; + if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) { + substr( $value, 0, 1 ) = ""; + substr( $value, -1, 1 ) = ""; + } + + # What column is this? + my $field = $fields[$i++]; + next COLUMN unless $field =~ /\S/; + $field =~ s/^\s//; + $field =~ s/\s$//; + + if ( $field =~ /^id$/i ) { + # Special case if this is the ID column + if ( $value =~ /^\d+$/ ) { + $template_id = 'update-' . $value; + push @{ $self->{'update_tickets'} }, $template_id; + } elsif ( $value =~ /^#base-(\d+)$/ ) { + $template_id = 'base-' . $1; + push @{ $self->{'base_tickets'} }, $template_id; + } elsif ( $value =~ /\S/ ) { + $template_id = 'create-' . $value; + push @{ $self->{'create_tickets'} }, $template_id; + } + } else { + # Some translations + if ( $field =~ /^Body$/i + || $field =~ /^Data$/i + || $field =~ /^Message$/i ) + { + $field = 'Content'; + } elsif ( $field =~ /^Summary$/i ) { + $field = 'Subject'; + } elsif ( $field =~ /^Queue$/i ) { + # Note that we found a queue + $queue = 1; + $value ||= $args{'Queue'}; + } elsif ( $field =~ /^Requestors?$/i ) { + $field = 'Requestor'; # Remove plural + # Note that we found a requestor + $requestor = 1; + $value ||= $args{'Requestor'}; + } + + # Tack onto the end of the template + $template .= $field . ": "; + $template .= (defined $value ? $value : ""); + $template .= "\n"; + $template .= "ENDOFCONTENT\n" + if $field =~ /^Content$/i; + } + } + + # Ignore blank lines + next unless $template; + + # If we didn't find a queue of requestor, tack on the defaults + if ( !$queue && $args{'Queue'} ) { + $template .= "Queue: $args{'Queue'}\n"; + } + if ( !$requestor && $args{'Requestor'} ) { + $template .= "Requestor: $args{'Requestor'}\n"; + } + + # If we never found an ID, come up with one + unless ($template_id) { + $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"}; + $template_id = "create-auto-$autoid"; + # Also, it's a ticket to create + push @{ $self->{'create_tickets'} }, $template_id; + } + + # Save the template we generated + $self->{'templates'}->{$template_id} = $template; + + } +} + +sub GetDeferred { + my $self = shift; + my $args = shift; + my $id = shift; + my $links = shift; + my $postponed = shift; + + # Deferred processing + push @$links, + ( + $id, + { DependsOn => $args->{'dependson'}, + DependedOnBy => $args->{'dependedonby'}, + RefersTo => $args->{'refersto'}, + ReferredToBy => $args->{'referredtoby'}, + Children => $args->{'children'}, + Parents => $args->{'parents'}, + } + ); + + push @$postponed, ( + + # Status is postponed so we don't violate dependencies + $id, { Status => $args->{'status'}, } + ); +} + +sub GetUpdateTemplate { + my $self = shift; + my $t = shift; + + my $string; + $string .= "Queue: " . $t->QueueObj->Name . "\n"; + $string .= "Subject: " . $t->Subject . "\n"; + $string .= "Status: " . $t->Status . "\n"; + $string .= "UpdateType: correspond\n"; + $string .= "Content: \n"; + $string .= "ENDOFCONTENT\n"; + $string .= "Due: " . $t->DueObj->AsString . "\n"; + $string .= "Starts: " . $t->StartsObj->AsString . "\n"; + $string .= "Started: " . $t->StartedObj->AsString . "\n"; + $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n"; + $string .= "Owner: " . $t->OwnerObj->Name . "\n"; + $string .= "Requestor: " . $t->RequestorAddresses . "\n"; + $string .= "Cc: " . $t->CcAddresses . "\n"; + $string .= "AdminCc: " . $t->AdminCcAddresses . "\n"; + $string .= "TimeWorked: " . $t->TimeWorked . "\n"; + $string .= "TimeEstimated: " . $t->TimeEstimated . "\n"; + $string .= "TimeLeft: " . $t->TimeLeft . "\n"; + $string .= "InitialPriority: " . $t->Priority . "\n"; + $string .= "FinalPriority: " . $t->FinalPriority . "\n"; + + foreach my $type ( sort keys %LINKTYPEMAP ) { + + # don't display duplicates + if ( $type eq "HasMember" + || $type eq "Members" + || $type eq "MemberOf" ) + { + next; + } + $string .= "$type: "; + + my $mode = $LINKTYPEMAP{$type}->{Mode}; + my $method = $LINKTYPEMAP{$type}->{Type}; + + my $links = ''; + while ( my $link = $t->$method->Next ) { + $links .= ", " if $links; + + my $object = $mode . "Obj"; + my $member = $link->$object; + $links .= $member->Id if $member; + } + $string .= $links; + $string .= "\n"; + } + + return $string; +} + +sub GetBaseTemplate { + my $self = shift; + my $t = shift; + + my $string; + $string .= "Queue: " . $t->Queue . "\n"; + $string .= "Subject: " . $t->Subject . "\n"; + $string .= "Status: " . $t->Status . "\n"; + $string .= "Due: " . $t->DueObj->Unix . "\n"; + $string .= "Starts: " . $t->StartsObj->Unix . "\n"; + $string .= "Started: " . $t->StartedObj->Unix . "\n"; + $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n"; + $string .= "Owner: " . $t->Owner . "\n"; + $string .= "Requestor: " . $t->RequestorAddresses . "\n"; + $string .= "Cc: " . $t->CcAddresses . "\n"; + $string .= "AdminCc: " . $t->AdminCcAddresses . "\n"; + $string .= "TimeWorked: " . $t->TimeWorked . "\n"; + $string .= "TimeEstimated: " . $t->TimeEstimated . "\n"; + $string .= "TimeLeft: " . $t->TimeLeft . "\n"; + $string .= "InitialPriority: " . $t->Priority . "\n"; + $string .= "FinalPriority: " . $t->FinalPriority . "\n"; + + return $string; +} + +sub GetCreateTemplate { + my $self = shift; + + my $string; + + $string .= "Queue: General\n"; + $string .= "Subject: \n"; + $string .= "Status: new\n"; + $string .= "Content: \n"; + $string .= "ENDOFCONTENT\n"; + $string .= "Due: \n"; + $string .= "Starts: \n"; + $string .= "Started: \n"; + $string .= "Resolved: \n"; + $string .= "Owner: \n"; + $string .= "Requestor: \n"; + $string .= "Cc: \n"; + $string .= "AdminCc:\n"; + $string .= "TimeWorked: \n"; + $string .= "TimeEstimated: \n"; + $string .= "TimeLeft: \n"; + $string .= "InitialPriority: \n"; + $string .= "FinalPriority: \n"; + + foreach my $type ( keys %LINKTYPEMAP ) { + + # don't display duplicates + if ( $type eq "HasMember" + || $type eq 'Members' + || $type eq 'MemberOf' ) + { + next; + } + $string .= "$type: \n"; + } + return $string; +} + +sub UpdateWatchers { + my $self = shift; + my $ticket = shift; + my $args = shift; + + my @results; + + foreach my $type (qw(Requestor Cc AdminCc)) { + my $method = $type . 'Addresses'; + my $oldaddr = $ticket->$method; + + # Skip unless we have a defined field + next unless defined $args->{$type}; + my $newaddr = $args->{$type}; + + my @old = split( /,\s*/, $oldaddr ); + my @new; + for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) { + # Sometimes these are email addresses, sometimes they're + # users. Try to guess which is which, as we want to deal + # with email addresses if at all possible. + if (/^\S+@\S+$/) { + push @new, $_; + } else { + # It doesn't look like an email address. Try to load it. + my $user = RT::User->new($self->CurrentUser); + $user->Load($_); + if ($user->Id) { + push @new, $user->EmailAddress; + } else { + push @new, $_; + } + } + } + + my %oldhash = map { $_ => 1 } @old; + my %newhash = map { $_ => 1 } @new; + + my @add = grep( !defined $oldhash{$_}, @new ); + my @delete = grep( !defined $newhash{$_}, @old ); + + foreach (@add) { + my ( $val, $msg ) = $ticket->AddWatcher( + Type => $type, + Email => $_ + ); + + push @results, + $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg; + } + + foreach (@delete) { + my ( $val, $msg ) = $ticket->DeleteWatcher( + Type => $type, + Email => $_ + ); + push @results, + $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg; + } + } + return @results; +} + +sub UpdateCustomFields { + my $self = shift; + my $ticket = shift; + my $args = shift; + + my @results; + foreach my $arg (keys %{$args}) { + next unless $arg =~ /^CustomField-(\d+)$/; + my $cf = $1; + + my $CustomFieldObj = RT::CustomField->new($self->CurrentUser); + $CustomFieldObj->SetContextObject( $ticket ); + $CustomFieldObj->LoadById($cf); + + my @values; + if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext + @values = ($args->{$arg}); + } else { + @values = split /\n/, $args->{$arg}; + } + + if ( ($CustomFieldObj->Type eq 'Freeform' + && ! $CustomFieldObj->SingleValue) || + $CustomFieldObj->Type =~ /text/i) { + foreach my $val (@values) { + $val =~ s/\r//g; + } + } + + foreach my $value (@values) { + next unless length($value); + my ( $val, $msg ) = $ticket->AddCustomFieldValue( + Field => $cf, + Value => $value + ); + push ( @results, $msg ); + } + } + return @results; +} + +sub PostProcess { + my $self = shift; + my $links = shift; + my $postponed = shift; + + # postprocessing: add links + + while ( my $template_id = shift(@$links) ) { + my $ticket = $T::Tickets{$template_id}; + $RT::Logger->debug( "Handling links for " . $ticket->Id ); + my %args = %{ shift(@$links) }; + + foreach my $type ( keys %LINKTYPEMAP ) { + next unless ( defined $args{$type} ); + foreach my $link ( + ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) + { + next unless $link; + + if ( $link =~ /^TOP$/i ) { + $RT::Logger->debug( "Building $type link for $link: " + . $T::Tickets{TOP}->Id ); + $link = $T::Tickets{TOP}->Id; + + } elsif ( $link !~ m/^\d+$/ ) { + my $key = "create-$link"; + if ( !exists $T::Tickets{$key} ) { + $RT::Logger->debug( + "Skipping $type link for $key (non-existent)"); + next; + } + $RT::Logger->debug( "Building $type link for $link: " + . $T::Tickets{$key}->Id ); + $link = $T::Tickets{$key}->Id; + } else { + $RT::Logger->debug("Building $type link for $link"); + } + + my ( $wval, $wmsg ) = $ticket->AddLink( + Type => $LINKTYPEMAP{$type}->{'Type'}, + $LINKTYPEMAP{$type}->{'Mode'} => $link, + Silent => 1 + ); + + $RT::Logger->warning("AddLink thru $link failed: $wmsg") + unless $wval; + + # push @non_fatal_errors, $wmsg unless ($wval); + } + + } + } + + # postponed actions -- Status only, currently + while ( my $template_id = shift(@$postponed) ) { + my $ticket = $T::Tickets{$template_id}; + $RT::Logger->debug( "Handling postponed actions for " . $ticket->id ); + my %args = %{ shift(@$postponed) }; + $ticket->SetStatus( $args{Status} ) if defined $args{Status}; + } + +} + +sub Options { + my $self = shift; + my $queues = RT::Queues->new($self->CurrentUser); + $queues->UnLimit; + my @names; + while (my $queue = $queues->Next) { + push @names, $queue->Id, $queue->Name; + } + return ( + { + 'name' => 'Queue', + 'label' => 'In queue', + 'type' => 'select', + 'options' => \@names + } + ) +} + +RT::Base->_ImportOverlays(); + +1; + diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index 0f11cc141..a483fba9f 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -258,7 +258,7 @@ sub Bcc { sub AddressesFromHeader { my $self = shift; my $field = shift; - my $header = $self->TemplateObj->MIMEObj->head->get($field); + my $header = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field)); my @addresses = Email::Address->parse($header); return (@addresses); @@ -277,7 +277,7 @@ sub SendMessage { # ability to pass @_ to a 'post' routine. my ( $self, $MIMEObj ) = @_; - my $msgid = $MIMEObj->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') ); chomp $msgid; $self->ScripActionObj->{_Message_ID}++; @@ -300,7 +300,7 @@ sub SendMessage { my $success = $msgid . " sent "; foreach (@EMAIL_RECIPIENT_HEADERS) { - my $recipients = $MIMEObj->head->get($_); + my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) ); $success .= " $_: " . $recipients if $recipients; } @@ -531,7 +531,7 @@ sub RecordOutgoingMailTransaction { $type = 'EmailRecord'; } - my $msgid = $MIMEObj->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') ); chomp $msgid; my ( $id, $msg ) = $transaction->Create( @@ -649,7 +649,7 @@ sub DeferDigestRecipients { # Have to get the list of addresses directly from the MIME header # at this point. - $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) ); foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { next unless $rcpt; my $user_obj = RT::User->new(RT->SystemUser); @@ -746,7 +746,7 @@ sub RemoveInappropriateRecipients { # If there are no recipients, don't try to send the message. # If the transaction has content and has the header RT-Squelch-Replies-To - my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') ); if ( my $attachment = $self->TransactionObj->Attachments->First ) { if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { @@ -922,7 +922,8 @@ sub GetFriendlyName { =head2 SetHeader FIELD, VALUE -Set the FIELD of the current MIME object into VALUE. +Set the FIELD of the current MIME object into VALUE, which should be in +characters, not bytes. Returns the new header, in bytes. =cut @@ -935,7 +936,7 @@ sub SetHeader { chomp $field; my $head = $self->TemplateObj->MIMEObj->head; $head->fold_length( $field, 10000 ); - $head->replace( $field, $val ); + $head->replace( $field, Encode::encode( "UTF-8", $val ) ); return $head->get($field); } @@ -976,7 +977,7 @@ sub SetSubject { $subject =~ s/(\r\n|\n|\s)/ /g; - $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + $self->SetHeader( 'Subject', $subject ); } @@ -992,11 +993,9 @@ sub SetSubjectToken { my $head = $self->TemplateObj->MIMEObj->head; $self->SetHeader( Subject => - Encode::encode_utf8( - RT::Interface::Email::AddSubjectTag( - Encode::decode_utf8( $head->get('Subject') ), - $self->TicketObj, - ), + RT::Interface::Email::AddSubjectTag( + Encode::decode( "UTF-8", $head->get('Subject') ), + $self->TicketObj, ), ); } @@ -1090,7 +1089,8 @@ sub PseudoReference { =head2 SetHeaderAsEncoding($field_name, $charset_encoding) -This routine converts the field into specified charset encoding. +This routine converts the field into specified charset encoding, then +applies the MIME-Header transfer encoding. =cut @@ -1101,12 +1101,12 @@ sub SetHeaderAsEncoding { my $head = $self->TemplateObj->MIMEObj->head; if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { - $head->replace( $field, RT->Config->Get('SMTPFrom') ); + $head->replace( $field, Encode::encode( "UTF-8", RT->Config->Get('SMTPFrom') ) ); return; } - my $value = $head->get( $field ); - $value = $self->MIMEEncodeString( $value, $enc ); + my $value = Encode::decode("UTF-8", $head->get( $field )); + $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes $head->replace( $field, $value ); } @@ -1116,7 +1116,8 @@ sub SetHeaderAsEncoding { Takes a perl string and optional encoding pass it over L<RT::Interface::Email/EncodeToMIME>. -Basicly encode a string using B encoding according to RFC2047. +Basicly encode a string using B encoding according to RFC2047, returning +bytes. =cut diff --git a/rt/lib/RT/Action/SendEmail.pm.orig b/rt/lib/RT/Action/SendEmail.pm.orig new file mode 100755 index 000000000..0f11cc141 --- /dev/null +++ b/rt/lib/RT/Action/SendEmail.pm.orig @@ -0,0 +1,1131 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +# Portions Copyright 2000 Tobias Brox <tobix@cpan.org> + +package RT::Action::SendEmail; + +use strict; +use warnings; + +use base qw(RT::Action); + +use RT::EmailParser; +use RT::Interface::Email; +use Email::Address; +our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc); + + +=head1 NAME + +RT::Action::SendEmail - An Action which users can use to send mail +or can subclassed for more specialized mail sending behavior. +RT::Action::AutoReply is a good example subclass. + +=head1 SYNOPSIS + + use base 'RT::Action::SendEmail'; + +=head1 DESCRIPTION + +Basically, you create another module RT::Action::YourAction which ISA +RT::Action::SendEmail. + +=head1 METHODS + +=head2 CleanSlate + +Cleans class-wide options, like L</AttachTickets>. + +=cut + +sub CleanSlate { + my $self = shift; + $self->AttachTickets(undef); +} + +=head2 Commit + +Sends the prepared message and writes outgoing record into DB if the feature is +activated in the config. + +=cut + +sub Commit { + my $self = shift; + + return abs $self->SendMessage( $self->TemplateObj->MIMEObj ) + unless RT->Config->Get('RecordOutgoingEmail'); + + $self->DeferDigestRecipients(); + my $message = $self->TemplateObj->MIMEObj; + + my $orig_message; + $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt( + Attachment => $self->TransactionObj->Attachments->First, + Ticket => $self->TicketObj, + ); + + my ($ret) = $self->SendMessage($message); + return abs( $ret ) if $ret <= 0; + + 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 + +Builds an outgoing email we're going to send using scrip's template. + +=cut + +sub Prepare { + my $self = shift; + + my ( $result, $message ) = $self->TemplateObj->Parse( + Argument => $self->Argument, + TicketObj => $self->TicketObj, + TransactionObj => $self->TransactionObj + ); + if ( !$result ) { + return (undef); + } + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + # Header + $self->SetRTSpecialHeaders(); + + my %seen; + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + @{ $self->{$type} } + = grep defined && length && !$seen{ lc $_ }++, + @{ $self->{$type} }; + } + + $self->RemoveInappropriateRecipients(); + + # Go add all the Tos, Ccs and Bccs that we need to to the message to + # make it happy, but only if we actually have values in those arrays. + +# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc + + for my $header (@EMAIL_RECIPIENT_HEADERS) { + + $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) ) + if (!$MIMEObj->head->get($header) + && $self->{$header} + && @{ $self->{$header} } ); + } + # PseudoTo (fake to headers) shouldn't get matched for message recipients. + # If we don't have any 'To' header (but do have other recipients), drop in + # the pseudo-to header. + $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) ) + if $self->{'PseudoTo'} + && @{ $self->{'PseudoTo'} } + && !$MIMEObj->head->get('To') + && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') ); + + # We should never have to set the MIME-Version header + $self->SetHeader( 'MIME-Version', '1.0' ); + + # fsck.com #5959: Since RT sends 8bit mail, we should say so. + $self->SetHeader( 'Content-Transfer-Encoding', '8bit' ); + + # For security reasons, we only send out textual mails. + foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) { + my $type = $part->mime_type || 'text/plain'; + $type = 'text/plain' unless RT::I18N::IsTextualContentType($type); + $part->head->mime_attr( "Content-Type" => $type ); + # utf-8 here is for _FindOrGuessCharset in I18N.pm + # it's not the final charset/encoding sent + $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); + } + + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, + RT->Config->Get('EmailOutputEncoding'), + 'mime_words_ok', ); + + # Build up a MIME::Entity that looks like the original message. + $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message') + && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) ); + + $self->AddTickets; + + my $attachment = $self->TransactionObj->Attachments->First; + if ($attachment + && !( + $attachment->GetHeader('X-RT-Encrypt') + || $self->TicketObj->QueueObj->Encrypt + ) + ) + { + $attachment->SetHeader( 'X-RT-Encrypt' => 1 ) + if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq + 'Success'; + } + + return $result; +} + +=head2 To + +Returns an array of L<Email::Address> objects containing all the To: recipients for this notification + +=cut + +sub To { + my $self = shift; + return ( $self->AddressesFromHeader('To') ); +} + +=head2 Cc + +Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification + +=cut + +sub Cc { + my $self = shift; + return ( $self->AddressesFromHeader('Cc') ); +} + +=head2 Bcc + +Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification + +=cut + +sub Bcc { + my $self = shift; + return ( $self->AddressesFromHeader('Bcc') ); + +} + +sub AddressesFromHeader { + my $self = shift; + my $field = shift; + my $header = $self->TemplateObj->MIMEObj->head->get($field); + my @addresses = Email::Address->parse($header); + + return (@addresses); +} + +=head2 SendMessage MIMEObj + +sends the message using RT's preferred API. +TODO: Break this out to a separate module + +=cut + +sub SendMessage { + + # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's + # ability to pass @_ to a 'post' routine. + my ( $self, $MIMEObj ) = @_; + + my $msgid = $MIMEObj->head->get('Message-ID'); + chomp $msgid; + + $self->ScripActionObj->{_Message_ID}++; + + $RT::Logger->info( $msgid . " #" + . $self->TicketObj->id . "/" + . $self->TransactionObj->id + . " - Scrip " + . ($self->ScripObj->id || '#rule'). " " + . ( $self->ScripObj->Description || '' ) ); + + my $status = RT::Interface::Email::SendEmail( + Entity => $MIMEObj, + Ticket => $self->TicketObj, + Transaction => $self->TransactionObj, + ); + + + return $status unless ($status > 0 || exists $self->{'Deferred'}); + + my $success = $msgid . " sent "; + foreach (@EMAIL_RECIPIENT_HEADERS) { + my $recipients = $MIMEObj->head->get($_); + $success .= " $_: " . $recipients if $recipients; + } + + if( exists $self->{'Deferred'} ) { + for (qw(daily weekly susp)) { + $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } ) + if exists $self->{'Deferred'}{ $_ }; + } + } + + $success =~ s/\n//g; + + $RT::Logger->info($success); + + return (1); +} + +=head2 AddAttachments + +Takes any attachments to this transaction and attaches them to the message +we're building. + +=cut + +sub AddAttachments { + my $self = shift; + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + $MIMEObj->head->delete('RT-Attach-Message'); + + my $attachments = RT::Attachments->new( RT->SystemUser ); + $attachments->Limit( + FIELD => 'TransactionId', + VALUE => $self->TransactionObj->Id + ); + + # Don't attach anything blank + $attachments->LimitNotEmpty; + $attachments->OrderBy( FIELD => 'id' ); + + # We want to make sure that we don't include the attachment that's + # being used as the "Content" of this message" unless that attachment's + # content type is not like text/... + my $transaction_content_obj = $self->TransactionObj->ContentObj; + + if ( $transaction_content_obj + && $transaction_content_obj->ContentType =~ m{text/}i ) + { + # If this was part of a multipart/alternative, skip all of the kids + my $parent = $transaction_content_obj->ParentObj; + if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'parent', + OPERATOR => '!=', + VALUE => $parent->Id, + ); + } else { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'id', + OPERATOR => '!=', + VALUE => $transaction_content_obj->Id, + ); + } + } + + # attach any of this transaction's attachments + my $seen_attachment = 0; + while ( my $attach = $attachments->Next ) { + if ( !$seen_attachment ) { + $MIMEObj->make_multipart( 'mixed', Force => 1 ); + $seen_attachment = 1; + } + $self->AddAttachment($attach); + } +} + +=head2 AddAttachment $attachment + +Takes one attachment object of L<RT::Attachment> class and attaches it to the message +we're building. + +=cut + +sub AddAttachment { + my $self = shift; + my $attach = shift; + my $MIMEObj = shift || $self->TemplateObj->MIMEObj; + + # $attach->TransactionObj may not always be $self->TransactionObj + return unless $attach->Id + and $attach->TransactionObj->CurrentUserCanSee; + + # ->attach expects just the disposition type; extract it if we have the header + # or default to "attachment" + my $disp = ($attach->GetHeader('Content-Disposition') || '') + =~ /^\s*(inline|attachment)/i ? $1 : "attachment"; + + $MIMEObj->attach( + Type => $attach->ContentType, + Charset => $attach->OriginalEncoding, + Data => $attach->OriginalContent, + Disposition => $disp, + Filename => $self->MIMEEncodeString( $attach->Filename ), + 'RT-Attachment:' => $self->TicketObj->Id . "/" + . $self->TransactionObj->Id . "/" + . $attach->id, + Encoding => '-SUGGEST', + ); +} + +=head2 AttachTickets [@IDs] + +Returns or set list of ticket's IDs that should be attached to an outgoing message. + +B<Note> this method works as a class method and setup things global, so you have to +clean list by passing undef as argument. + +=cut + +{ + my $list = []; + + sub AttachTickets { + my $self = shift; + $list = [ grep defined, @_ ] if @_; + return @$list; + } +} + +=head2 AddTickets + +Attaches tickets to the current message, list of tickets' ids get from +L</AttachTickets> method. + +=cut + +sub AddTickets { + my $self = shift; + $self->AddTicket($_) foreach $self->AttachTickets; + return; +} + +=head2 AddTicket $ID + +Attaches a ticket with ID to the message. + +Each ticket is attached as multipart entity and all its messages and attachments +are attached as sub entities in order of creation, but only if transaction type +is Create or Correspond. + +=cut + +sub AddTicket { + my $self = shift; + my $tid = shift; + + my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj ); + my $txn_alias = $attachs->TransactionAlias; + $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' ); + $attachs->Limit( + ALIAS => $txn_alias, + FIELD => 'Type', + VALUE => 'Correspond' + ); + $attachs->LimitByTicket($tid); + $attachs->LimitNotEmpty; + $attachs->OrderBy( FIELD => 'Created' ); + + my $ticket_mime = MIME::Entity->build( + Type => 'multipart/mixed', + Top => 0, + Description => "ticket #$tid", + ); + while ( my $attachment = $attachs->Next ) { + $self->AddAttachment( $attachment, $ticket_mime ); + } + if ( $ticket_mime->parts ) { + my $email_mime = $self->TemplateObj->MIMEObj; + $email_mime->make_multipart; + $email_mime->add_part($ticket_mime); + } + return; +} + +=head2 RecordOutgoingMailTransaction MIMEObj + +Record a transaction in RT with this outgoing message for future record-keeping purposes + +=cut + +sub RecordOutgoingMailTransaction { + my $self = shift; + my $MIMEObj = shift; + + my @parts = $MIMEObj->parts; + my @attachments; + my @keep; + foreach my $part (@parts) { + my $attach = $part->head->get('RT-Attachment'); + if ($attach) { + $RT::Logger->debug( + "We found an attachment. we want to not record it."); + push @attachments, $attach; + } else { + $RT::Logger->debug("We found a part. we want to record it."); + push @keep, $part; + } + } + $MIMEObj->parts( \@keep ); + foreach my $attachment (@attachments) { + $MIMEObj->head->add( 'RT-Attachment', $attachment ); + } + + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' ); + + my $transaction + = RT::Transaction->new( $self->TransactionObj->CurrentUser ); + +# XXX: TODO -> Record attachments as references to things in the attachments table, maybe. + + my $type; + if ( $self->TransactionObj->Type eq 'Comment' ) { + $type = 'CommentEmailRecord'; + } else { + $type = 'EmailRecord'; + } + + my $msgid = $MIMEObj->head->get('Message-ID'); + chomp $msgid; + + my ( $id, $msg ) = $transaction->Create( + Ticket => $self->TicketObj->Id, + Type => $type, + Data => $msgid, + MIMEObj => $MIMEObj, + ActivateScrips => 0 + ); + + if ($id) { + $self->{'OutgoingMailTransaction'} = $id; + } else { + $RT::Logger->warning( + "Could not record outgoing message transaction: $msg"); + } + return $id; +} + +=head2 SetRTSpecialHeaders + +This routine adds all the random headers that RT wants in a mail message +that don't matter much to anybody else. + +=cut + +sub SetRTSpecialHeaders { + my $self = shift; + + $self->SetSubject(); + $self->SetSubjectToken(); + $self->SetHeaderAsEncoding( 'Subject', + RT->Config->Get('EmailOutputEncoding') ) + if ( RT->Config->Get('EmailOutputEncoding') ); + $self->SetReturnAddress(); + $self->SetReferencesHeaders(); + + unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) { + + # Get Message-ID for this txn + my $msgid = ""; + if ( my $msg = $self->TransactionObj->Message->First ) { + $msgid = $msg->GetHeader("RT-Message-ID") + || $msg->GetHeader("Message-ID"); + } + + # If there is one, and we can parse it, then base our Message-ID on it + if ( $msgid + and $msgid + =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/ + "<$1." . $self->TicketObj->id + . "-" . $self->ScripObj->id + . "-" . $self->ScripActionObj->{_Message_ID} + . "@" . RT->Config->Get('Organization') . ">"/eg + and $2 == $self->TicketObj->id + ) + { + $self->SetHeader( "Message-ID" => $msgid ); + } else { + $self->SetHeader( + 'Message-ID' => RT::Interface::Email::GenMessageId( + Ticket => $self->TicketObj, + Scrip => $self->ScripObj, + ScripAction => $self->ScripActionObj + ), + ); + } + } + + if (my $precedence = RT->Config->Get('DefaultMailPrecedence') + and !$self->TemplateObj->MIMEObj->head->get("Precedence") + ) { + $self->SetHeader( 'Precedence', $precedence ); + } + + $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') ); + $self->SetHeader( 'RT-Ticket', + RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); + $self->SetHeader( 'Managed-by', + "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); + +# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be +# refactored into user's method. + if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress + and RT->Config->Get('UseOriginatorHeader') + ) { + $self->SetHeader( 'RT-Originator', $email ); + } + +} + + +sub DeferDigestRecipients { + my $self = shift; + $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id ); + + # The digest attribute will be an array of notifications that need to + # be sent for this transaction. The array will have the following + # format for its objects. + # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc} + # -> sent -> {true|false} + # The "sent" flag will be used by the cron job to indicate that it has + # run on this transaction. + # In a perfect world we might move this hash construction to the + # extension module itself. + my $digest_hash = {}; + + foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) { + # If we have a "PseudoTo", the "To" contains it, so we don't need to access it + next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) ); + $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) ); + + # Store the 'daily digest' folk in an array. + my ( @send_now, @daily_digest, @weekly_digest, @suspended ); + + # Have to get the list of addresses directly from the MIME header + # at this point. + $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { + next unless $rcpt; + my $user_obj = RT::User->new(RT->SystemUser); + $user_obj->LoadByEmail($rcpt); + if ( ! $user_obj->id ) { + # If there's an email address in here without an associated + # RT user, pass it on through. + $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail."); + push( @send_now, $rcpt ); + next; + } + + my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || ''; + $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt"); + + if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) } + elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) } + elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) } + else { push( @send_now, $rcpt ) } + } + + # Reset the relevant mail field. + $RT::Logger->debug( "Removing deferred recipients from $mailfield: line"); + if (@send_now) { + $self->SetHeader( $mailfield, join( ', ', @send_now ) ); + } else { # No recipients! Remove the header. + $self->TemplateObj->MIMEObj->head->delete($mailfield); + } + + # Push the deferred addresses into the appropriate field in + # our attribute hash, with the appropriate mail header. + $RT::Logger->debug( + "Setting deferred recipients for attribute creation"); + $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest); + $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest); + $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended); + } + + if ( scalar keys %$digest_hash ) { + + # Save the hash so that we can add it as an attribute to the + # outgoing email transaction. + $self->{'Deferred'} = $digest_hash; + } else { + $RT::Logger->debug( "No recipients found for deferred delivery on " + . "transaction #" + . $self->TransactionObj->id ); + } +} + + + +sub RecordDeferredRecipients { + my $self = shift; + return unless exists $self->{'Deferred'}; + + my $txn_id = $self->{'OutgoingMailTransaction'}; + return unless $txn_id; + + my $txn_obj = RT::Transaction->new( $self->CurrentUser ); + $txn_obj->Load( $txn_id ); + my( $ret, $msg ) = $txn_obj->AddAttribute( + Name => 'DeferredRecipients', + Content => $self->{'Deferred'} + ); + $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) + unless $ret; + + return ($ret,$msg); +} + +=head2 SquelchMailTo + +Returns list of the addresses to squelch on this transaction. + +=cut + +sub SquelchMailTo { + my $self = shift; + return map $_->Content, $self->TransactionObj->SquelchMailTo; +} + +=head2 RemoveInappropriateRecipients + +Remove addresses that are RT addresses or that are on this transaction's blacklist + +=cut + +sub RemoveInappropriateRecipients { + my $self = shift; + + my @blacklist = (); + + # If there are no recipients, don't try to send the message. + # If the transaction has content and has the header RT-Squelch-Replies-To + + my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + if ( my $attachment = $self->TransactionObj->Attachments->First ) { + + if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { + + # What do we want to do with this? It's probably (?) a bounce + # caused by one of the watcher addresses being broken. + # Default ("true") is to redistribute, for historical reasons. + + if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) { + + # Don't send to any watchers. + @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS); + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message based on site configuration." + ); + } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq + 'privileged' ) + { + + # Only send to "privileged" watchers. + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + foreach my $addr ( @{ $self->{$type} } ) { + my $user = RT::User->new(RT->SystemUser); + $user->LoadByEmail($addr); + push @blacklist, $addr unless $user->id && $user->Privileged; + } + } + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message to unprivileged users based on site configuration." + ); + } + } + + if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) { + push @blacklist, split( /,/, $squelch ); + } + } + + # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted + push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo; + + # Cycle through the people we're sending to and pull out anyone on the + # system blacklist + + # Trim leading and trailing spaces. + @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } + Email::Address->parse( join ', ', grep defined, @blacklist ); + + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + my @addrs; + foreach my $addr ( @{ $self->{$type} } ) { + + # Weed out any RT addresses. We really don't want to talk to ourselves! + # If we get a reply back, that means it's not an RT address + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + if ( grep $addr eq $_, @blacklist ) { + $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping"); + next; + } + push @addrs, $addr; + } + foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) { + # never send email to itself + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + push @addrs, $addr; + } + @{ $self->{$type} } = @addrs; + } +} + +=head2 SetReturnAddress is_comment => BOOLEAN + +Calculate and set From and Reply-To headers based on the is_comment flag. + +=cut + +sub SetReturnAddress { + + my $self = shift; + my %args = ( + is_comment => 0, + friendly_name => undef, + @_ + ); + + # From and Reply-To + # $args{is_comment} should be set if the comment address is to be used. + my $replyto; + + if ( $args{'is_comment'} ) { + $replyto = $self->TicketObj->QueueObj->CommentAddress + || RT->Config->Get('CommentAddress'); + } else { + $replyto = $self->TicketObj->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); + } + + unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { + $self->SetFrom( %args, From => $replyto ); + } + + unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { + $self->SetHeader( 'Reply-To', "$replyto" ); + } + +} + +=head2 SetFrom ( From => emailaddress ) + +Set the From: address for outgoing email + +=cut + +sub SetFrom { + my $self = shift; + my %args = @_; + + my $from = $args{From}; + + if ( RT->Config->Get('UseFriendlyFromLine') ) { + my $friendly_name = $self->GetFriendlyName(%args); + $from = + sprintf( + RT->Config->Get('FriendlyFromLineFormat'), + $self->MIMEEncodeString( + $friendly_name, RT->Config->Get('EmailOutputEncoding') + ), + $args{From} + ); + } + + $self->SetHeader( 'From', $from ); + + #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine, + #and then Outlook prepends "rt@machine on behalf of" to the From: header + $self->SetHeader( 'Sender', $from ); +} + +=head2 GetFriendlyName + +Calculate the proper Friendly Name based on the creator of the transaction + +=cut + +sub GetFriendlyName { + my $self = shift; + my %args = ( + is_comment => 0, + friendly_name => '', + @_ + ); + my $friendly_name = $args{friendly_name}; + + unless ( $friendly_name ) { + $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName; + if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string + $friendly_name = $1; + } + } + + $friendly_name =~ s/"/\\"/g; + return $friendly_name; + +} + +=head2 SetHeader FIELD, VALUE + +Set the FIELD of the current MIME object into VALUE. + +=cut + +sub SetHeader { + my $self = shift; + my $field = shift; + my $val = shift; + + chomp $val; + chomp $field; + my $head = $self->TemplateObj->MIMEObj->head; + $head->fold_length( $field, 10000 ); + $head->replace( $field, $val ); + return $head->get($field); +} + +=head2 SetSubject + +This routine sets the subject. it does not add the rt tag. That gets done elsewhere +If subject is already defined via template, it uses that. otherwise, it tries to get +the transaction's subject. + +=cut + +sub SetSubject { + my $self = shift; + my $subject; + + if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { + return (); + } + + # don't use Transaction->Attachments because it caches + # and anything which later calls ->Attachments will be hurt + # by our RowsPerPage() call. caching is hard. + my $message = RT::Attachments->new( $self->CurrentUser ); + $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id); + $message->OrderBy( FIELD => 'id', ORDER => 'ASC' ); + $message->RowsPerPage(1); + + if ( $self->{'Subject'} ) { + $subject = $self->{'Subject'}; + } elsif ( my $first = $message->First ) { + my $tmp = $first->GetHeader('Subject'); + $subject = defined $tmp ? $tmp : $self->TicketObj->Subject; + } else { + $subject = $self->TicketObj->Subject; + } + $subject = '' unless defined $subject; + chomp $subject; + + $subject =~ s/(\r\n|\n|\s)/ /g; + + $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + +} + +=head2 SetSubjectToken + +This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. + +=cut + +sub SetSubjectToken { + my $self = shift; + + my $head = $self->TemplateObj->MIMEObj->head; + $self->SetHeader( + Subject => + Encode::encode_utf8( + RT::Interface::Email::AddSubjectTag( + Encode::decode_utf8( $head->get('Subject') ), + $self->TicketObj, + ), + ), + ); +} + +=head2 SetReferencesHeaders + +Set References and In-Reply-To headers for this message. + +=cut + +sub SetReferencesHeaders { + my $self = shift; + + my $top = $self->TransactionObj->Message->First; + unless ( $top ) { + $self->SetHeader( References => $self->PseudoReference ); + return (undef); + } + + my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' ); + my @references = split( /\s+/m, $top->GetHeader('References') || '' ); + my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' ); + + # There are two main cases -- this transaction was created with + # the RT Web UI, and hence we want to *not* append its Message-ID + # to the References and In-Reply-To. OR it came from an outside + # source, and we should treat it as per the RFC + my $org = RT->Config->Get('Organization'); + if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) { + + # Make all references which are internal be to version which we + # have sent out + + for ( @references, @in_reply_to ) { + s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/ + "<$1." . $self->TicketObj->id . + "-" . $self->ScripObj->id . + "-" . $self->ScripActionObj->{_Message_ID} . + "@" . $org . ">"/eg + } + + # In reply to whatever the internal message was in reply to + $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) ); + + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # References are unchanged from internal + } else { + + # In reply to that message + $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) ); + + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # Push that message onto the end of the references + push @references, @msgid; + } + + # Push pseudo-ref to the front + my $pseudo_ref = $self->PseudoReference; + @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references ); + + # If there are more than 10 references headers, remove all but the + # first four and the last six (Gotta keep this from growing + # forever) + splice( @references, 4, -6 ) if ( $#references >= 10 ); + + # Add on the references + $self->SetHeader( 'References', join( " ", @references ) ); + $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 ); + +} + +=head2 PseudoReference + +Returns a fake Message-ID: header for the ticket to allow a base level of threading + +=cut + +sub PseudoReference { + + my $self = shift; + my $pseudo_ref + = '<RT-Ticket-' + . $self->TicketObj->id . '@' + . RT->Config->Get('Organization') . '>'; + return $pseudo_ref; +} + +=head2 SetHeaderAsEncoding($field_name, $charset_encoding) + +This routine converts the field into specified charset encoding. + +=cut + +sub SetHeaderAsEncoding { + my $self = shift; + my ( $field, $enc ) = ( shift, shift ); + + my $head = $self->TemplateObj->MIMEObj->head; + + if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { + $head->replace( $field, RT->Config->Get('SMTPFrom') ); + return; + } + + my $value = $head->get( $field ); + $value = $self->MIMEEncodeString( $value, $enc ); + $head->replace( $field, $value ); + +} + +=head2 MIMEEncodeString + +Takes a perl string and optional encoding pass it over +L<RT::Interface::Email/EncodeToMIME>. + +Basicly encode a string using B encoding according to RFC2047. + +=cut + +sub MIMEEncodeString { + my $self = shift; + return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); +} + +RT::Base->_ImportOverlays(); + +1; + diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm index 07fdea3b2..af1f82c15 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -128,19 +128,17 @@ sub Create { $Attachment->make_singlepart; # Get the subject - my $Subject = $Attachment->head->get( 'subject', 0 ); + my $Subject = Encode::decode( 'UTF-8', $Attachment->head->get( 'subject' ) ); $Subject = '' unless defined $Subject; chomp $Subject; - utf8::decode( $Subject ) unless utf8::is_utf8( $Subject ); #Get the Message-ID - my $MessageId = $Attachment->head->get( 'Message-ID', 0 ); + my $MessageId = Encode::decode( "UTF-8", $Attachment->head->get( 'Message-ID' ) ); defined($MessageId) or $MessageId = ''; chomp ($MessageId); $MessageId =~ s/^<(.*?)>$/$1/o; #Get the filename - my $Filename = mime_recommended_filename($Attachment); # remove path part. @@ -148,8 +146,7 @@ sub Create { # MIME::Head doesn't support perl strings well and can return # octets which later will be double encoded in low-level code - my $head = $Attachment->head->as_string; - utf8::decode( $head ) unless utf8::is_utf8( $head ); + my $head = Encode::decode( 'UTF-8', $Attachment->head->as_string ); # If a message has no bodyhandle, that means that it has subparts (or appears to) # and we should act accordingly. @@ -289,7 +286,7 @@ before returning it. sub Content { my $self = shift; return $self->_DecodeLOB( - $self->ContentType, + $self->GetHeader('Content-Type'), # Includes charset, unlike ->ContentType $self->ContentEncoding, $self->_Value('Content', decode_utf8 => 0), ); @@ -320,7 +317,6 @@ sub OriginalContent { } return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); - my $enc = $self->OriginalEncoding; my $content; if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) { @@ -333,18 +329,20 @@ sub OriginalContent { return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); } - # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. - local $@; - Encode::_utf8_off($content); + my $entity = MIME::Entity->new(); + $entity->head->add("Content-Type", $self->GetHeader("Content-Type")); + $entity->bodyhandle( MIME::Body::Scalar->new( $content ) ); + my $from = RT::I18N::_FindOrGuessCharset($entity); + $from = 'utf-8' if not $from or not Encode::find_encoding($from); - if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { - # If we somehow fail to do the decode, at least push out the raw bits - eval { return( Encode::decode_utf8($content)) } || return ($content); - } + my $to = RT::I18N::_CanonicalizeCharset( + $self->OriginalEncoding || 'utf-8' + ); - eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; + local $@; + eval { Encode::from_to($content, $from => $to) }; if ($@) { - $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); + $RT::Logger->error("Could not convert attachment from $from to $to: ".$@); } return $content; } diff --git a/rt/lib/RT/Config.pm b/rt/lib/RT/Config.pm index 23441934f..07f4aafa8 100644 --- a/rt/lib/RT/Config.pm +++ b/rt/lib/RT/Config.pm @@ -1024,7 +1024,6 @@ sub Get { my $res; if ( $user && $user->id && $META{$name}->{'Overridable'} ) { - $user = $user->UserObj if $user->isa('RT::CurrentUser'); my $prefs = $user->Preferences($RT::System); $res = $prefs->{$name} if $prefs; } diff --git a/rt/lib/RT/Config.pm.orig b/rt/lib/RT/Config.pm.orig new file mode 100644 index 000000000..62aae1c35 --- /dev/null +++ b/rt/lib/RT/Config.pm.orig @@ -0,0 +1,1382 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +package RT::Config; + +use strict; +use warnings; + + +use File::Spec (); + +=head1 NAME + + RT::Config - RT's config + +=head1 SYNOPSYS + + # get config object + use RT::Config; + my $config = RT::Config->new; + $config->LoadConfigs; + + # get or set option + my $rt_web_path = $config->Get('WebPath'); + $config->Set(EmailOutputEncoding => 'latin1'); + + # get config object from RT package + use RT; + RT->LoadConfig; + my $config = RT->Config; + +=head1 DESCRIPTION + +C<RT::Config> class provide access to RT's and RT extensions' config files. + +RT uses two files for site configuring: + +First file is F<RT_Config.pm> - core config file. This file is shipped +with RT distribution and contains default values for all available options. +B<You should never edit this file.> + +Second file is F<RT_SiteConfig.pm> - site config file. You can use it +to customize your RT instance. In this file you can override any option +listed in core config file. + +RT extensions could also provide thier config files. Extensions should +use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for +config files, where <NAME> is extension name. + +B<NOTE>: All options from RT's config and extensions' configs are saved +in one place and thus extension could override RT's options, but it is not +recommended. + +=cut + +=head2 %META + +Hash of Config options that may be user overridable +or may require more logic than should live in RT_*Config.pm + +Keyed by config name, there are several properties that +can be set for each config optin: + + Section - What header this option should be grouped + under on the user Settings page + Overridable - Can users change this option + SortOrder - Within a Section, how should the options be sorted + for display to the user + Widget - Mason component path to widget that should be used + to display this config option + WidgetArguments - An argument hash passed to the WIdget + Description - Friendly description to show the user + Values - Arrayref of options (for select Widget) + ValuesLabel - Hashref, key is the Value from the Values + list, value is a user friendly description + of the value + Callback - subref that receives no arguments. It returns + a hashref of items that are added to the rest + of the WidgetArguments + PostLoadCheck - subref passed the RT::Config object and the current + setting of the config option. Can make further checks + (such as seeing if a library is installed) and then change + the setting of this or other options in the Config using + the RT::Config option. + Obfuscate - subref passed the RT::Config object, current setting of the config option + and a user object, can return obfuscated value. it's called in + RT->Config->GetObfuscated() + +=cut + +our %META = ( + # General user overridable options + DefaultQueue => { + Section => 'General', + Overridable => 1, + SortOrder => 1, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Default queue', #loc + Callback => sub { + my $ret = { Values => [], ValuesLabel => {}}; + my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'}); + $q->UnLimit; + while (my $queue = $q->Next) { + next unless $queue->CurrentUserHasRight("CreateTicket"); + push @{$ret->{Values}}, $queue->Id; + $ret->{ValuesLabel}{$queue->Id} = $queue->Name; + } + return $ret; + }, + } + }, + RememberDefaultQueue => { + Section => 'General', + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Remember default queue' # loc + } + }, + UsernameFormat => { + Section => 'General', + Overridable => 1, + SortOrder => 3, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Username format', # loc + Values => [qw(concise verbose)], + ValuesLabel => { + concise => 'Short usernames', # loc + verbose => 'Name and email address', # loc + }, + }, + }, + AutocompleteOwners => { + Section => 'General', + Overridable => 1, + SortOrder => 3.1, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Use autocomplete to find owners?', # loc + Hints => 'Replaces the owner dropdowns with textboxes' #loc + } + }, + WebDefaultStylesheet => { + Section => 'General', #loc + Overridable => 1, + SortOrder => 4, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Theme', #loc + # XXX: we need support for 'get values callback' + Values => [qw(web2 freeside2.1 freeside3 aileron ballard)], + }, + PostLoadCheck => sub { + my $self = shift; + my $value = $self->Get('WebDefaultStylesheet'); + + my @comp_roots = RT::Interface::Web->ComponentRoots; + for my $comp_root (@comp_roots) { + return if -d $comp_root.'/NoAuth/css/'.$value; + } + + $RT::Logger->warning( + "The default stylesheet ($value) does not exist in this instance of RT. " + . "Defaulting to freeside3." + ); + + #$self->Set('WebDefaultStylesheet', 'aileron'); + $self->Set('WebDefaultStylesheet', 'freeside3'); + }, + }, + UseSideBySideLayout => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Use a two column layout for create and update forms?' # loc + } + }, + MessageBoxRichText => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 5.1, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'WYSIWYG message composer' # loc + } + }, + MessageBoxRichTextHeight => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 6, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'WYSIWYG composer height', # loc + } + }, + MessageBoxWidth => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 7, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Message box width', #loc + }, + }, + MessageBoxHeight => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 8, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Message box height', #loc + }, + }, + MessageBoxWrap => { + Section => 'Ticket composition', #loc + Overridable => 1, + SortOrder => 8.1, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Message box wrapping', #loc + Values => [qw(SOFT HARD)], + Hints => "When the WYSIWYG editor is not enabled, this setting determines whether automatic line wraps in the ticket message box are sent to RT or not.", # loc + }, + }, + DefaultTimeUnitsToHours => { + Section => 'Ticket composition', #loc + Overridable => 1, + SortOrder => 9, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Enter time in hours by default', #loc + Hints => 'Only for entry, not display', #loc + }, + }, + SearchResultsRefreshInterval => { + Section => 'General', #loc + Overridable => 1, + SortOrder => 9, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Search results refresh interval', #loc + Values => [qw(0 120 300 600 1200 3600 7200)], + ValuesLabel => { + 0 => "Don't refresh search results.", #loc + 120 => "Refresh search results every 2 minutes.", #loc + 300 => "Refresh search results every 5 minutes.", #loc + 600 => "Refresh search results every 10 minutes.", #loc + 1200 => "Refresh search results every 20 minutes.", #loc + 3600 => "Refresh search results every 60 minutes.", #loc + 7200 => "Refresh search results every 120 minutes.", #loc + }, + }, + }, + + # User overridable options for RT at a glance + HomePageRefreshInterval => { + Section => 'RT at a glance', #loc + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Home page refresh interval', #loc + Values => [qw(0 120 300 600 1200 3600 7200)], + ValuesLabel => { + 0 => "Don't refresh home page.", #loc + 120 => "Refresh home page every 2 minutes.", #loc + 300 => "Refresh home page every 5 minutes.", #loc + 600 => "Refresh home page every 10 minutes.", #loc + 1200 => "Refresh home page every 20 minutes.", #loc + 3600 => "Refresh home page every 60 minutes.", #loc + 7200 => "Refresh home page every 120 minutes.", #loc + }, + }, + }, + + # User overridable options for Ticket displays + MaxInlineBody => { + Section => 'Ticket display', #loc + Overridable => 1, + SortOrder => 1, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Maximum inline message length', #loc + Hints => + "Length in characters; Use '0' to show all messages inline, regardless of length" #loc + }, + }, + OldestTransactionsFirst => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Show oldest history first', #loc + }, + }, + DeferTransactionLoading => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 3, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Hide ticket history by default', #loc + }, + }, + ShowUnreadMessageNotifications => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 4, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Notify me of unread messages', #loc + }, + + }, + PlainTextPre => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'add <pre> tag around plain text attachments', #loc + Hints => "Use this to protect the format of plain text" #loc + }, + }, + PlainTextMono => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'display wrapped and formatted plain text attachments', #loc + Hints => 'Use css rules to display text monospaced and with formatting preserved, but wrap as needed. This does not work well with IE6 and you should use the previous option', #loc + }, + }, + DisplayAfterQuickCreate => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 6, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'On Quick Create, redirect to ticket display', #loc + #Hints => '', #loc + }, + }, + MoreAboutRequestorTicketList => { + Section => 'Ticket display', #loc + Overridable => 1, + SortOrder => 6, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => q|What tickets to display in the 'More about requestor' box|, #loc + Values => [qw(Active Inactive All None)], + ValuesLabel => { + Active => "Show the Requestor's 10 highest priority active tickets", #loc + Inactive => "Show the Requestor's 10 highest priority inactive tickets", #loc + All => "Show the Requestor's 10 highest priority tickets", #loc + None => "Show no tickets for the Requestor", #loc + }, + }, + }, + SimplifiedRecipients => { + Section => 'Ticket display', #loc + Overridable => 1, + SortOrder => 7, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => q|Show simplified recipient list on ticket update|, #loc + }, + }, + DisplayTicketAfterQuickCreate => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 8, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => q{Display ticket after "Quick Create"}, #loc + }, + }, + + # User overridable locale options + DateTimeFormat => { + Section => 'Locale', #loc + Overridable => 1, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Date format', #loc + Callback => sub { my $ret = { Values => [], ValuesLabel => {}}; + my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'}); + $date->SetToNow; + foreach my $value ($date->Formatters) { + push @{$ret->{Values}}, $value; + $ret->{ValuesLabel}{$value} = $date->Get( + Format => $value, + Timezone => 'user', + ); + } + return $ret; + }, + }, + }, + + RTAddressRegexp => { + Type => 'SCALAR', + PostLoadCheck => sub { + my $self = shift; + my $value = $self->Get('RTAddressRegexp'); + if (not $value) { + $RT::Logger->debug( + 'The RTAddressRegexp option is not set in the config.' + .' Not setting this option results in additional SQL queries to' + .' check whether each address belongs to RT or not.' + .' It is especially important to set this option if RT recieves' + .' emails on addresses that are not in the database or config.' + ); + } elsif (ref $value and ref $value eq "Regexp") { + # Ensure that the regex is case-insensitive; while the + # local part of email addresses is _technically_ + # case-sensitive, most MTAs don't treat it as such. + $RT::Logger->warning( + 'RTAddressRegexp is set to a case-sensitive regular expression.' + .' This may lead to mail loops with MTAs which treat the' + .' local part as case-insensitive -- which is most of them.' + ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/; + } + }, + }, + # User overridable mail options + EmailFrequency => { + Section => 'Mail', #loc + Overridable => 1, + Default => 'Individual messages', + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Email delivery', #loc + Values => [ + 'Individual messages', #loc + 'Daily digest', #loc + 'Weekly digest', #loc + 'Suspended' #loc + ] + } + }, + NotifyActor => { + Section => 'Mail', #loc + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Outgoing mail', #loc + Hints => 'Should RT send you mail for ticket updates you make?', #loc + } + }, + + # this tends to break extensions that stash links in ticket update pages + Organization => { + Type => 'SCALAR', + PostLoadCheck => sub { + my ($self,$value) = @_; + $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace. Please fix this.") + if $value =~ /\s/;; + }, + }, + + # Internal config options + FullTextSearch => { + Type => 'HASH', + PostLoadCheck => sub { + my $self = shift; + my $v = $self->Get('FullTextSearch'); + return unless $v->{Enable} and $v->{Indexed}; + my $dbtype = $self->Get('DatabaseType'); + if ($dbtype eq 'Oracle') { + if (not $v->{IndexName}) { + $RT::Logger->error("No IndexName set for full-text index; disabling"); + $v->{Enable} = $v->{Indexed} = 0; + } + } elsif ($dbtype eq 'Pg') { + my $bad = 0; + if (not $v->{'Column'}) { + $RT::Logger->error("No Column set for full-text index; disabling"); + $v->{Enable} = $v->{Indexed} = 0; + } elsif ($v->{'Column'} eq "Content" + and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) { + $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling"); + $v->{Enable} = $v->{Indexed} = 0; + } + } elsif ($dbtype eq 'mysql') { + if (not $v->{'Table'}) { + $RT::Logger->error("No Table set for full-text index; disabling"); + $v->{Enable} = $v->{Indexed} = 0; + } elsif ($v->{'Table'} eq "Attachments") { + $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling"); + $v->{Enable} = $v->{Indexed} = 0; + } elsif (not $v->{'MaxMatches'}) { + $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000"); + $v->{MaxMatches} = 10_000; + } + } else { + $RT::Logger->error("Indexed full-text-search not supported for $dbtype"); + $v->{Indexed} = 0; + } + }, + }, + DisableGraphViz => { + Type => 'SCALAR', + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + return if $value; + return if $INC{'GraphViz.pm'}; + local $@; + return if eval {require GraphViz; 1}; + $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@"); + $self->Set( DisableGraphViz => 1 ); + }, + }, + DisableGD => { + Type => 'SCALAR', + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + return if $value; + return if $INC{'GD.pm'}; + local $@; + return if eval {require GD; 1}; + $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@"); + $self->Set( DisableGD => 1 ); + }, + }, + MailPlugins => { Type => 'ARRAY' }, + Plugins => { + Type => 'ARRAY', + PostLoadCheck => sub { + my $self = shift; + my $value = $self->Get('Plugins'); + # XXX Remove in RT 4.2 + return unless $value and grep {$_ eq "RT::FM"} @{$value}; + warn 'RTFM has been integrated into core RT, and must be removed from your @Plugins'; + }, + }, + GnuPG => { Type => 'HASH' }, + GnuPGOptions => { Type => 'HASH', + PostLoadCheck => sub { + my $self = shift; + my $gpg = $self->Get('GnuPG'); + return unless $gpg->{'Enable'}; + my $gpgopts = $self->Get('GnuPGOptions'); + unless (-d $gpgopts->{homedir} && -r _ ) { # no homedir, no gpg + $RT::Logger->debug( + "RT's GnuPG libraries couldn't successfully read your". + " configured GnuPG home directory (".$gpgopts->{homedir} + ."). PGP support has been disabled"); + $gpg->{'Enable'} = 0; + return; + } + + + require RT::Crypt::GnuPG; + unless (RT::Crypt::GnuPG->Probe()) { + $RT::Logger->debug( + "RT's GnuPG libraries couldn't successfully execute gpg.". + " PGP support has been disabled"); + $gpg->{'Enable'} = 0; + } + } + }, + ReferrerWhitelist => { Type => 'ARRAY' }, + ResolveDefaultUpdateType => { + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + return unless $value; + $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated. '. + 'You can change the site default in your %Lifecycles config.'); + } + }, + WebPath => { + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + + # "In most cases, you should leave $WebPath set to '' (an empty value)." + return unless $value; + + # try to catch someone who assumes that you shouldn't leave this empty + if ($value eq '/') { + $RT::Logger->error("For the WebPath config option, use the empty string instead of /"); + return; + } + + # $WebPath requires a leading / but no trailing /, or it can be blank. + return if $value =~ m{^/.+[^/]$}; + + if ($value =~ m{/$}) { + $RT::Logger->error("The WebPath config option requires no trailing slash"); + } + + if ($value !~ m{^/}) { + $RT::Logger->error("The WebPath config option requires a leading slash"); + } + }, + }, + WebDomain => { + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + + if (!$value) { + $RT::Logger->error("You must set the WebDomain config option"); + return; + } + + if ($value =~ m{^(\w+://)}) { + $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)"); + return; + } + + if ($value =~ m{(/.*)}) { + $RT::Logger->error("The WebDomain config option must not contain a path ($1)"); + return; + } + + if ($value =~ m{:(\d*)}) { + $RT::Logger->error("The WebDomain config option must not contain a port ($1)"); + return; + } + }, + }, + WebPort => { + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + + if (!$value) { + $RT::Logger->error("You must set the WebPort config option"); + return; + } + + if ($value !~ m{^\d+$}) { + $RT::Logger->error("The WebPort config option must be an integer"); + } + }, + }, + WebBaseURL => { + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + + if (!$value) { + $RT::Logger->error("You must set the WebBaseURL config option"); + return; + } + + if ($value !~ m{^https?://}i) { + $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)"); + } + + if ($value =~ m{/$}) { + $RT::Logger->error("The WebBaseURL config option requires no trailing slash"); + } + + if ($value =~ m{^https?://.+?(/[^/].*)}i) { + $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)"); + } + }, + }, + WebURL => { + PostLoadCheck => sub { + my $self = shift; + my $value = shift; + + if (!$value) { + $RT::Logger->error("You must set the WebURL config option"); + return; + } + + if ($value !~ m{^https?://}i) { + $RT::Logger->error("The WebURL config option must contain a scheme (http or https)"); + } + + if ($value !~ m{/$}) { + $RT::Logger->error("The WebURL config option requires a trailing slash"); + } + }, + }, + EmailInputEncodings => { + Type => 'ARRAY', + PostLoadCheck => sub { + my $self = shift; + my $value = $self->Get('EmailInputEncodings'); + return unless $value && @$value; + + my %seen; + foreach my $encoding ( grep defined && length, splice @$value ) { + next if $seen{ $encoding }; + if ( $encoding eq '*' ) { + unshift @$value, '*'; + next; + } + + my $canonic = Encode::resolve_alias( $encoding ); + unless ( $canonic ) { + warn "Unknown encoding '$encoding' in \@EmailInputEncodings option"; + } + elsif ( $seen{ $canonic }++ ) { + next; + } + else { + push @$value, $canonic; + } + } + }, + }, + + ActiveStatus => { + Type => 'ARRAY', + PostLoadCheck => sub { + my $self = shift; + return unless shift; + # XXX Remove in RT 4.2 + warn <<EOT; +The ActiveStatus configuration has been replaced by the new Lifecycles +functionality. You should set the 'active' property of the 'default' +lifecycle and add transition rules; see RT_Config.pm for documentation. +EOT + }, + }, + InactiveStatus => { + Type => 'ARRAY', + PostLoadCheck => sub { + my $self = shift; + return unless shift; + # XXX Remove in RT 4.2 + warn <<EOT; +The InactiveStatus configuration has been replaced by the new Lifecycles +functionality. You should set the 'inactive' property of the 'default' +lifecycle and add transition rules; see RT_Config.pm for documentation. +EOT + }, + }, +); +my %OPTIONS = (); + +=head1 METHODS + +=head2 new + +Object constructor returns new object. Takes no arguments. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) ? ref($proto) : $proto; + my $self = bless {}, $class; + $self->_Init(@_); + return $self; +} + +sub _Init { + return; +} + +=head2 InitConfig + +Do nothin right now. + +=cut + +sub InitConfig { + my $self = shift; + my %args = ( File => '', @_ ); + $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/; + return 1; +} + +=head2 LoadConfigs + +Load all configs. First of all load RT's config then load +extensions' config files in alphabetical order. +Takes no arguments. + +=cut + +sub LoadConfigs { + my $self = shift; + + $self->InitConfig( File => 'RT_Config.pm' ); + $self->LoadConfig( File => 'RT_Config.pm' ); + + my @configs = $self->Configs; + $self->InitConfig( File => $_ ) foreach @configs; + $self->LoadConfig( File => $_ ) foreach @configs; + return; +} + +=head1 LoadConfig + +Takes param hash with C<File> field. +First, the site configuration file is loaded, in order to establish +overall site settings like hostname and name of RT instance. +Then, the core configuration file is loaded to set fallback values +for all settings; it bases some values on settings from the site +configuration file. + +B<Note> that core config file don't change options if site config +has set them so to add value to some option instead of +overriding you have to copy original value from core config file. + +=cut + +sub LoadConfig { + my $self = shift; + my %args = ( File => '', @_ ); + $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/; + if ( $args{'File'} eq 'RT_SiteConfig.pm' + and my $site_config = $ENV{RT_SITE_CONFIG} ) + { + $self->_LoadConfig( %args, File => $site_config ); + } else { + $self->_LoadConfig(%args); + } + $args{'File'} =~ s/Site(?=Config\.pm$)//; + $self->_LoadConfig(%args); + return 1; +} + +sub _LoadConfig { + my $self = shift; + my %args = ( File => '', @_ ); + + my ($is_ext, $is_site); + if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) { + ($is_ext, $is_site) = ('', 1); + } else { + $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : ''; + $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0; + } + + eval { + package RT; + local *Set = sub(\[$@%]@) { + my ( $opt_ref, @args ) = @_; + my ( $pack, $file, $line ) = caller; + return $self->SetFromConfig( + Option => $opt_ref, + Value => [@args], + Package => $pack, + File => $file, + Line => $line, + SiteConfig => $is_site, + Extension => $is_ext, + ); + }; + my @etc_dirs = ($RT::LocalEtcPath); + push @etc_dirs, RT->PluginDirs('etc') if $is_ext; + push @etc_dirs, $RT::EtcPath, @INC; + local @INC = @etc_dirs; + require $args{'File'}; + }; + if ($@) { + return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/; + if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) { + die qq{Couldn't load RT config file $args{'File'}:\n\n$@}; + } + + my $username = getpwuid($>); + my $group = getgrgid($(); + + my ( $file_path, $fileuid, $filegid ); + foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) { + my $tmp = File::Spec->catfile( $_, $args{File} ); + ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ]; + if ( defined $fileuid ) { + $file_path = $tmp; + last; + } + } + unless ($file_path) { + die + qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n} + . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@}; + } + + my $message = <<EOF; + +RT couldn't load RT config file %s as: + user: $username + group: $group + +The file is owned by user %s and group %s. + +This usually means that the user/group your webserver is running +as cannot read the file. Be careful not to make the permissions +on this file too liberal, because it contains database passwords. +You may need to put the webserver user in the appropriate group +(%s) or change permissions be able to run succesfully. +EOF + + my $fileusername = getpwuid($fileuid); + my $filegroup = getgrgid($filegid); + my $errormessage = sprintf( $message, + $file_path, $fileusername, $filegroup, $filegroup ); + die "$errormessage\n$@"; + } + return 1; +} + +sub PostLoadCheck { + my $self = shift; + foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) { + $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) ); + } +} + +=head2 Configs + +Returns list of config files found in local etc, plugins' etc +and main etc directories. + +=cut + +sub Configs { + my $self = shift; + + my @configs = (); + foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) { + my $mask = File::Spec->catfile( $path, "*_Config.pm" ); + my @files = glob $mask; + @files = grep !/^RT_Config\.pm$/, + grep $_ && /^\w+_Config\.pm$/, + map { s/^.*[\\\/]//; $_ } @files; + push @configs, sort @files; + } + + my %seen; + @configs = grep !$seen{$_}++, @configs; + return @configs; +} + +=head2 Get + +Takes name of the option as argument and returns its current value. + +In the case of a user-overridable option, first checks the user's +preferences before looking for site-wide configuration. + +Returns values from RT_SiteConfig, RT_Config and then the %META hash +of configuration variables's "Default" for this config variable, +in that order. + +Returns different things in scalar and array contexts. For scalar +options it's not that important, however for arrays and hash it's. +In scalar context returns references to arrays and hashes. + +Use C<scalar> perl's op to force context, especially when you use +C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)> +as perl's '=>' op doesn't change context of the right hand argument to +scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>. + +It's also important for options that have no default value(no default +in F<etc/RT_Config.pm>). If you don't force scalar context then you'll +get empty list and all your named args will be messed up. For example +C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)> +will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably +unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)> +will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>. + +=cut + +sub Get { + my ( $self, $name, $user ) = @_; + + my $res; + if ( $user && $user->id && $META{$name}->{'Overridable'} ) { + $user = $user->UserObj if $user->isa('RT::CurrentUser'); + my $prefs = $user->Preferences($RT::System); + $res = $prefs->{$name} if $prefs; + } + $res = $OPTIONS{$name} unless defined $res; + $res = $META{$name}->{'Default'} unless defined $res; + return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' ); +} + +=head2 GetObfuscated + +the same as Get, except it returns Obfuscated value via Obfuscate sub + +=cut + +sub GetObfuscated { + my $self = shift; + my ( $name, $user ) = @_; + my $obfuscate = $META{$name}->{Obfuscate}; + + # we use two Get here is to simplify the logic of the return value + # configs need obfuscation are supposed to be less, so won't be too heavy + + return $self->Get(@_) unless $obfuscate; + + my $res = $self->Get(@_); + $res = $obfuscate->( $self, $res, $user ); + return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' ); +} + +=head2 Set + +Set option's value to new value. Takes name of the option and new value. +Returns old value. + +The new value should be scalar, array or hash depending on type of the option. +If the option is not defined in meta or the default RT config then it is of +scalar type. + +=cut + +sub Set { + my ( $self, $name ) = ( shift, shift ); + + my $old = $OPTIONS{$name}; + my $type = $META{$name}->{'Type'} || 'SCALAR'; + if ( $type eq 'ARRAY' ) { + $OPTIONS{$name} = [@_]; + { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); } + } elsif ( $type eq 'HASH' ) { + $OPTIONS{$name} = {@_}; + { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); } + } else { + $OPTIONS{$name} = shift; + {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; } + } + $META{$name}->{'Type'} = $type; + return $self->_ReturnValue( $old, $type ); +} + +sub _ReturnValue { + my ( $self, $res, $type ) = @_; + return $res unless wantarray; + + if ( $type eq 'ARRAY' ) { + return @{ $res || [] }; + } elsif ( $type eq 'HASH' ) { + return %{ $res || {} }; + } + return $res; +} + +sub SetFromConfig { + my $self = shift; + my %args = ( + Option => undef, + Value => [], + Package => 'RT', + File => '', + Line => 0, + SiteConfig => 1, + Extension => 0, + @_ + ); + + unless ( $args{'File'} ) { + ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1); + } + + my $opt = $args{'Option'}; + + my $type; + my $name = $self->__GetNameByRef($opt); + if ($name) { + $type = ref $opt; + $name =~ s/.*:://; + } else { + $name = $$opt; + $type = $META{$name}->{'Type'} || 'SCALAR'; + } + + # if option is already set we have to check where + # it comes from and may be ignore it + if ( exists $OPTIONS{$name} ) { + if ( $type eq 'HASH' ) { + $args{'Value'} = [ + @{ $args{'Value'} }, + @{ $args{'Value'} }%2? (undef) : (), + $self->Get( $name ), + ]; + } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) { + # if it's site config of an extension then it can only + # override options that came from its main config + if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) { + my %source = %{ $META{$name}->{'Source'} }; + warn + "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored." + ." This option earlier has been set in $source{'File'} line $source{'Line'}." + ." To overide this option use ". ($source{'Extension'}||'RT') + ." site config." + ; + return 1; + } + } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) { + # if it's core config then we can override any option that came from another + # core config, but not site config + + my %source = %{ $META{$name}->{'Source'} }; + if ( $source{'Extension'} ne $args{'Extension'} ) { + # as a site config is loaded earlier then its base config + # then we warn only on different extensions, for example + # RTIR's options is set in main site config + warn + "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored." + ." It may be ok, but we want you to be aware." + ." This option has been set earlier in $source{'File'} line $source{'Line'}." + ; + } + + return 1; + } + } + + $META{$name}->{'Type'} = $type; + foreach (qw(Package File Line SiteConfig Extension)) { + $META{$name}->{'Source'}->{$_} = $args{$_}; + } + $self->Set( $name, @{ $args{'Value'} } ); + + return 1; +} + + our %REF_SYMBOLS = ( + SCALAR => '$', + ARRAY => '@', + HASH => '%', + CODE => '&', + ); + +{ + my $last_pack = ''; + + sub __GetNameByRef { + my $self = shift; + my $ref = shift; + my $pack = shift; + if ( !$pack && $last_pack ) { + my $tmp = $self->__GetNameByRef( $ref, $last_pack ); + return $tmp if $tmp; + } + $pack ||= 'main::'; + $pack .= '::' unless substr( $pack, -2 ) eq '::'; + + no strict 'refs'; + my $name = undef; + + # scan $pack's nametable(hash) + foreach my $k ( keys %{$pack} ) { + + # The hash for main:: has a reference to itself + next if $k eq 'main::'; + + # if the entry has a trailing '::' then + # it is a link to another name space + if ( substr( $k, -2 ) eq '::') { + $name = $self->__GetNameByRef( $ref, $pack eq 'main::'? $k : $pack.$k ); + return $name if $name; + } + + # entry of the table with references to + # SCALAR, ARRAY... and other types with + # the same name + my $entry = ${$pack}{$k}; + next unless $entry; + + # Inlined constants are simplified in the symbol table -- + # namely, when possible, you only get a reference back in + # $entry, rather than a full GLOB. In 5.10, scalar + # constants began being inlined this way; starting in 5.20, + # list constants are also inlined. Notably, ref(GLOB) is + # undef, but inlined constants are currently either REF, + # SCALAR, or ARRAY. + next if ref($entry); + + my $ref_type = ref($ref); + + # regex/arrayref/hashref/coderef are stored in SCALAR glob + $ref_type = 'SCALAR' if $ref_type eq 'REF'; + + my $entry_ref = *{$entry}{ $ref_type }; + next if ref $entry_ref && ref $entry_ref ne ref $ref; + next unless $entry_ref; + + # if references are equal then we've found + if ( $entry_ref == $ref ) { + $last_pack = $pack; + return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k; + } + } + return ''; + } +} + +=head2 Metadata + + +=head2 Meta + +=cut + +sub Meta { + return $META{ $_[1] }; +} + +sub Sections { + my $self = shift; + my %seen; + my @sections = sort + grep !$seen{$_}++, + map $_->{'Section'} || 'General', + values %META; + return @sections; +} + +sub Options { + my $self = shift; + my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ ); + my @res = keys %META; + + @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'}, + @res + ) if defined $args{'Section'}; + + if ( defined $args{'Overridable'} ) { + @res + = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'}, + @res ); + } + + if ( $args{'Sorted'} ) { + @res = sort { + ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999) + || $a cmp $b + } @res; + } else { + @res = sort { $a cmp $b } @res; + } + return @res; +} + +=head2 AddOption( Name => '', Section => '', ... ) + +=cut + +sub AddOption { + my $self = shift; + my %args = ( + Name => undef, + Section => undef, + Overridable => 0, + SortOrder => undef, + Widget => '/Widgets/Form/String', + WidgetArguments => {}, + @_ + ); + + unless ( $args{Name} ) { + $RT::Logger->error("Need Name to add a new config"); + return; + } + + unless ( $args{Section} ) { + $RT::Logger->error("Need Section to add a new config option"); + return; + } + + $META{ delete $args{Name} } = \%args; +} + +=head2 DeleteOption( Name => '' ) + +=cut + +sub DeleteOption { + my $self = shift; + my %args = ( + Name => undef, + @_ + ); + if ( $args{Name} ) { + delete $META{$args{Name}}; + } + else { + $RT::Logger->error("Need Name to remove a config option"); + return; + } +} + +=head2 UpdateOption( Name => '' ), Section => '', ... ) + +=cut + +sub UpdateOption { + my $self = shift; + my %args = ( + Name => undef, + Section => undef, + Overridable => undef, + SortOrder => undef, + Widget => undef, + WidgetArguments => undef, + @_ + ); + + my $name = delete $args{Name}; + + unless ( $name ) { + $RT::Logger->error("Need Name to update a new config"); + return; + } + + unless ( exists $META{$name} ) { + $RT::Logger->error("Config $name doesn't exist"); + return; + } + + for my $type ( keys %args ) { + next unless defined $args{$type}; + $META{$name}{$type} = $args{$type}; + } + return 1; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm index d0587d4fe..03636c8c3 100644 --- a/rt/lib/RT/Crypt/GnuPG.pm +++ b/rt/lib/RT/Crypt/GnuPG.pm @@ -401,14 +401,15 @@ sub SignEncrypt { my $entity = $args{'Entity'}; if ( $args{'Sign'} && !defined $args{'Signer'} ) { + my @addresses = Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( 'From' ))); $args{'Signer'} = UseKeyForSigning() - || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address; + || $addresses[0]->address; } if ( $args{'Encrypt'} && !$args{'Recipients'} ) { my %seen; $args{'Recipients'} = [ grep $_ && !$seen{ $_ }++, map $_->address, - map Email::Address->parse( $entity->head->get( $_ ) ), + map Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( $_ ) ) ), qw(To Cc Bcc) ]; } @@ -520,7 +521,7 @@ sub SignEncryptRFC3156 { $gnupg->options->push_recipients( $_ ) foreach map UseKeyForEncryption($_) || $_, grep !$seen{ $_ }++, map $_->address, - map Email::Address->parse( $entity->head->get( $_ ) ), + map Email::Address->parse( Encode::decode( "UTF-8", $entity->head->get( $_ ) ) ), qw(To Cc Bcc); my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); diff --git a/rt/lib/RT/CurrentUser.pm b/rt/lib/RT/CurrentUser.pm index c11d46031..6ffe14761 100755 --- a/rt/lib/RT/CurrentUser.pm +++ b/rt/lib/RT/CurrentUser.pm @@ -54,7 +54,7 @@ use RT::CurrentUser; - # laod + # load my $current_user = RT::CurrentUser->new; $current_user->Load(...); # or @@ -255,9 +255,6 @@ sub loc_fuzzy { my $self = shift; return '' if !defined $_[0] || $_[0] eq ''; - # XXX: work around perl's deficiency when matching utf8 data - return $_[0] if Encode::is_utf8($_[0]); - return $self->LanguageHandle->maketext_fuzzy( @_ ); } diff --git a/rt/lib/RT/CustomField.pm.orig b/rt/lib/RT/CustomField.pm.orig new file mode 100644 index 000000000..e71bbf78a --- /dev/null +++ b/rt/lib/RT/CustomField.pm.orig @@ -0,0 +1,2170 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +package RT::CustomField; + +use strict; +use warnings; + +use Scalar::Util 'blessed'; + +use base 'RT::Record'; + +sub Table {'CustomFields'} + + +use RT::CustomFieldValues; +use RT::ObjectCustomFields; +use RT::ObjectCustomFieldValues; + +our %FieldTypes = ( + Select => { + sort_order => 10, + selection_type => 1, + + labels => [ 'Select multiple values', # loc + 'Select one value', # loc + 'Select up to [_1] values', # loc + ], + + render_types => { + multiple => [ + + # Default is the first one + 'Select box', # loc + 'List', # loc + ], + single => [ 'Select box', # loc + 'Dropdown', # loc + 'List', # loc + ] + }, + + }, + Freeform => { + sort_order => 20, + selection_type => 0, + + labels => [ 'Enter multiple values', # loc + 'Enter one value', # loc + 'Enter up to [_1] values', # loc + ] + }, + Text => { + sort_order => 30, + selection_type => 0, + labels => [ + 'Fill in multiple text areas', # loc + 'Fill in one text area', # loc + 'Fill in up to [_1] text areas', # loc + ] + }, + Wikitext => { + sort_order => 40, + selection_type => 0, + labels => [ + 'Fill in multiple wikitext areas', # loc + 'Fill in one wikitext area', # loc + 'Fill in up to [_1] wikitext areas', # loc + ] + }, + + Image => { + sort_order => 50, + selection_type => 0, + labels => [ + 'Upload multiple images', # loc + 'Upload one image', # loc + 'Upload up to [_1] images', # loc + ] + }, + Binary => { + sort_order => 60, + selection_type => 0, + labels => [ + 'Upload multiple files', # loc + 'Upload one file', # loc + 'Upload up to [_1] files', # loc + ] + }, + + Combobox => { + sort_order => 70, + selection_type => 1, + labels => [ + 'Combobox: Select or enter multiple values', # loc + 'Combobox: Select or enter one value', # loc + 'Combobox: Select or enter up to [_1] values', # loc + ] + }, + Autocomplete => { + sort_order => 80, + selection_type => 1, + labels => [ + 'Enter multiple values with autocompletion', # loc + 'Enter one value with autocompletion', # loc + 'Enter up to [_1] values with autocompletion', # loc + ] + }, + + Date => { + sort_order => 90, + selection_type => 0, + labels => [ + 'Select multiple dates', # loc + 'Select date', # loc + 'Select up to [_1] dates', # loc + ] + }, + DateTime => { + sort_order => 100, + selection_type => 0, + labels => [ + 'Select multiple datetimes', # loc + 'Select datetime', # loc + 'Select up to [_1] datetimes', # loc + ] + }, + TimeValue => { + sort_order => 105, + selection_type => 0, + labels => [ + 'Enter multiple time values (UNSUPPORTED)', + 'Enter a time value', + 'Enter [_1] time values (UNSUPPORTED)', + ] + }, + + IPAddress => { + sort_order => 110, + selection_type => 0, + + labels => [ 'Enter multiple IP addresses', # loc + 'Enter one IP address', # loc + 'Enter up to [_1] IP addresses', # loc + ] + }, + IPAddressRange => { + sort_order => 120, + selection_type => 0, + + labels => [ 'Enter multiple IP address ranges', # loc + 'Enter one IP address range', # loc + 'Enter up to [_1] IP address ranges', # loc + ] + }, +); + + +our %FRIENDLY_OBJECT_TYPES = (); + +RT::CustomField->_ForObjectType( 'RT::Queue-RT::Ticket' => "Tickets", ); #loc +RT::CustomField->_ForObjectType( + 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", ); #loc +RT::CustomField->_ForObjectType( 'RT::User' => "Users", ); #loc +RT::CustomField->_ForObjectType( 'RT::Queue' => "Queues", ); #loc +RT::CustomField->_ForObjectType( 'RT::Group' => "Groups", ); #loc + +our $RIGHTS = { + SeeCustomField => 'View custom fields', # loc_pair + AdminCustomField => 'Create, modify and delete custom fields', # loc_pair + AdminCustomFieldValues => 'Create, modify and delete custom fields values', # loc_pair + ModifyCustomField => 'Add, modify and delete custom field values for objects' # loc_pair +}; + +our $RIGHT_CATEGORIES = { + SeeCustomField => 'General', + AdminCustomField => 'Admin', + AdminCustomFieldValues => 'Admin', + ModifyCustomField => 'Staff', +}; + +# Tell RT::ACE that this sort of object can get acls granted +$RT::ACE::OBJECT_TYPES{'RT::CustomField'} = 1; + +__PACKAGE__->AddRights(%$RIGHTS); +__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES); + +=head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...] + +Adds the given rights to the list of possible rights. This method +should be called during server startup, not at runtime. + +=cut + +sub AddRights { + my $self = shift; + my %new = @_; + $RIGHTS = { %$RIGHTS, %new }; + %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES, + map { lc($_) => $_ } keys %new); +} + +sub AvailableRights { + my $self = shift; + return $RIGHTS; +} + +=head2 RightCategories + +Returns a hashref where the keys are rights for this type of object and the +values are the category (General, Staff, Admin) the right falls into. + +=cut + +sub RightCategories { + return $RIGHT_CATEGORIES; +} + +=head2 AddRightCategories C<RIGHT>, C<CATEGORY> [, ...] + +Adds the given right and category pairs to the list of right categories. This +method should be called during server startup, not at runtime. + +=cut + +sub AddRightCategories { + my $self = shift if ref $_[0] or $_[0] eq __PACKAGE__; + my %new = @_; + $RIGHT_CATEGORIES = { %$RIGHT_CATEGORIES, %new }; +} + +=head1 NAME + + RT::CustomField_Overlay - overlay for RT::CustomField + +=head1 DESCRIPTION + +=head1 'CORE' METHODS + +=head2 Create PARAMHASH + +Create takes a hash of values and creates a row in the database: + + varchar(200) 'Name'. + varchar(200) 'Type'. + int(11) 'MaxValues'. + varchar(255) 'Pattern'. + smallint(6) 'Repeated'. + varchar(255) 'Description'. + int(11) 'SortOrder'. + varchar(255) 'LookupType'. + smallint(6) 'Disabled'. + +C<LookupType> is generally the result of either +C<RT::Ticket->CustomFieldLookupType> or C<RT::Transaction->CustomFieldLookupType>. + +=cut + +sub Create { + my $self = shift; + my %args = ( + Name => '', + Type => '', + MaxValues => 0, + Pattern => '', + Description => '', + Disabled => 0, + LookupType => '', + Repeated => 0, + LinkValueTo => '', + IncludeContentForValue => '', + @_, + ); + + unless ( $self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField') ) { + return (0, $self->loc('Permission Denied')); + } + + if ( $args{TypeComposite} ) { + @args{'Type', 'MaxValues'} = split(/-/, $args{TypeComposite}, 2); + } + elsif ( $args{Type} =~ s/(?:(Single)|Multiple)$// ) { + # old style Type string + $args{'MaxValues'} = $1 ? 1 : 0; + } + $args{'MaxValues'} = int $args{'MaxValues'}; + + if ( !exists $args{'Queue'}) { + # do nothing -- things below are strictly backward compat + } + elsif ( ! $args{'Queue'} ) { + unless ( $self->CurrentUser->HasRight( Object => $RT::System, Right => 'AssignCustomFields') ) { + return ( 0, $self->loc('Permission Denied') ); + } + $args{'LookupType'} = 'RT::Queue-RT::Ticket'; + } + else { + my $queue = RT::Queue->new($self->CurrentUser); + $queue->Load($args{'Queue'}); + unless ($queue->Id) { + return (0, $self->loc("Queue not found")); + } + unless ( $queue->CurrentUserHasRight('AssignCustomFields') ) { + return ( 0, $self->loc('Permission Denied') ); + } + $args{'LookupType'} = 'RT::Queue-RT::Ticket'; + $args{'Queue'} = $queue->Id; + } + + my ($ok, $msg) = $self->_IsValidRegex( $args{'Pattern'} ); + return (0, $self->loc("Invalid pattern: [_1]", $msg)) unless $ok; + + if ( $args{'MaxValues'} != 1 && $args{'Type'} =~ /(text|combobox)$/i ) { + $RT::Logger->debug("Support for 'multiple' Texts or Comboboxes is not implemented"); + $args{'MaxValues'} = 1; + } + + if ( $args{'RenderType'} ||= undef ) { + my $composite = join '-', @args{'Type', 'MaxValues'}; + return (0, $self->loc("This custom field has no Render Types")) + unless $self->HasRenderTypes( $composite ); + + if ( $args{'RenderType'} eq $self->DefaultRenderType( $composite ) ) { + $args{'RenderType'} = undef; + } else { + return (0, $self->loc("Invalid Render Type") ) + unless grep $_ eq $args{'RenderType'}, $self->RenderTypes( $composite ); + } + } + + $args{'ValuesClass'} = undef if ($args{'ValuesClass'} || '') eq 'RT::CustomFieldValues'; + if ( $args{'ValuesClass'} ||= undef ) { + return (0, $self->loc("This Custom Field can not have list of values")) + unless $self->IsSelectionType( $args{'Type'} ); + + unless ( $self->ValidateValuesClass( $args{'ValuesClass'} ) ) { + return (0, $self->loc("Invalid Custom Field values source")); + } + } + + (my $rv, $msg) = $self->SUPER::Create( + Name => $args{'Name'}, + Type => $args{'Type'}, + RenderType => $args{'RenderType'}, + MaxValues => $args{'MaxValues'}, + Pattern => $args{'Pattern'}, + BasedOn => $args{'BasedOn'}, + ValuesClass => $args{'ValuesClass'}, + Description => $args{'Description'}, + Disabled => $args{'Disabled'}, + LookupType => $args{'LookupType'}, + Repeated => $args{'Repeated'}, + ); + + if ($rv) { + if ( exists $args{'LinkValueTo'}) { + $self->SetLinkValueTo($args{'LinkValueTo'}); + } + + if ( exists $args{'IncludeContentForValue'}) { + $self->SetIncludeContentForValue($args{'IncludeContentForValue'}); + } + + if ( exists $args{'UILocation'} ) { + $self->SetUILocation( $args{'UILocation'} ); + } + + if ( exists $args{'NoClone'} ) { + $self->SetNoClone( $args{'NoClone'} ); + } + + return ($rv, $msg) unless exists $args{'Queue'}; + + # Compat code -- create a new ObjectCustomField mapping + my $OCF = RT::ObjectCustomField->new( $self->CurrentUser ); + $OCF->Create( + CustomField => $self->Id, + ObjectId => $args{'Queue'}, + ); + } + + return ($rv, $msg); +} + +=head2 Load ID/NAME + +Load a custom field. If the value handed in is an integer, load by custom field ID. Otherwise, Load by name. + +=cut + +sub Load { + my $self = shift; + my $id = shift || ''; + + if ( $id =~ /^\d+$/ ) { + return $self->SUPER::Load( $id ); + } else { + return $self->LoadByName( Name => $id ); + } +} + + + +=head2 LoadByName (Queue => QUEUEID, Name => NAME) + +Loads the Custom field named NAME. + +Will load a Disabled Custom Field even if there is a non-disabled Custom Field +with the same Name. + +If a Queue parameter is specified, only look for ticket custom fields tied to that Queue. + +If the Queue parameter is '0', look for global ticket custom fields. + +If no queue parameter is specified, look for any and all custom fields with this name. + +BUG/TODO, this won't let you specify that you only want user or group CFs. + +=cut + +# Compatibility for API change after 3.0 beta 1 +*LoadNameAndQueue = \&LoadByName; +# Change after 3.4 beta. +*LoadByNameAndQueue = \&LoadByName; + +sub LoadByName { + my $self = shift; + my %args = ( + Queue => undef, + Name => undef, + @_, + ); + + unless ( defined $args{'Name'} && length $args{'Name'} ) { + $RT::Logger->error("Couldn't load Custom Field without Name"); + return wantarray ? (0, $self->loc("No name provided")) : 0; + } + + # if we're looking for a queue by name, make it a number + if ( defined $args{'Queue'} && ($args{'Queue'} =~ /\D/ || !$self->ContextObject) ) { + my $QueueObj = RT::Queue->new( $self->CurrentUser ); + $QueueObj->Load( $args{'Queue'} ); + $args{'Queue'} = $QueueObj->Id; + $self->SetContextObject( $QueueObj ) + unless $self->ContextObject; + } + + # XXX - really naive implementation. Slow. - not really. still just one query + + my $CFs = RT::CustomFields->new( $self->CurrentUser ); + $CFs->SetContextObject( $self->ContextObject ); + my $field = $args{'Name'} =~ /\D/? 'Name' : 'id'; + $CFs->Limit( FIELD => $field, VALUE => $args{'Name'}, CASESENSITIVE => 0); + # Don't limit to queue if queue is 0. Trying to do so breaks + # RT::Group type CFs. + if ( defined $args{'Queue'} ) { + $CFs->LimitToQueue( $args{'Queue'} ); + } + + # When loading by name, we _can_ load disabled fields, but prefer + # non-disabled fields. + $CFs->FindAllRows; + $CFs->OrderByCols( + { FIELD => "Disabled", ORDER => 'ASC' }, + ); + + # We only want one entry. + $CFs->RowsPerPage(1); + + # version before 3.8 just returns 0, so we need to test if wantarray to be + # backward compatible. + return wantarray ? (0, $self->loc("Not found")) : 0 unless my $first = $CFs->First; + + return $self->LoadById( $first->id ); +} + + + + +=head2 Custom field values + +=head3 Values FIELD + +Return a object (collection) of all acceptable values for this Custom Field. +Class of the object can vary and depends on the return value +of the C<ValuesClass> method. + +=cut + +*ValuesObj = \&Values; + +sub Values { + my $self = shift; + + my $class = $self->ValuesClass; + if ( $class ne 'RT::CustomFieldValues') { + eval "require $class" or die "$@"; + } + my $cf_values = $class->new( $self->CurrentUser ); + # if the user has no rights, return an empty object + if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) { + $cf_values->LimitToCustomField( $self->Id ); + } else { + $cf_values->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' ); + } + return ($cf_values); +} + + +=head3 AddValue HASH + +Create a new value for this CustomField. Takes a paramhash containing the elements Name, Description and SortOrder + +=cut + +sub AddValue { + my $self = shift; + my %args = @_; + + unless ($self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues')) { + return (0, $self->loc('Permission Denied')); + } + + # allow zero value + if ( !defined $args{'Name'} || $args{'Name'} eq '' ) { + return (0, $self->loc("Can't add a custom field value without a name")); + } + + my $newval = RT::CustomFieldValue->new( $self->CurrentUser ); + return $newval->Create( %args, CustomField => $self->Id ); +} + + + + +=head3 DeleteValue ID + +Deletes a value from this custom field by id. + +Does not remove this value for any article which has had it selected + +=cut + +sub DeleteValue { + my $self = shift; + my $id = shift; + unless ( $self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues') ) { + return (0, $self->loc('Permission Denied')); + } + + my $val_to_del = RT::CustomFieldValue->new( $self->CurrentUser ); + $val_to_del->Load( $id ); + unless ( $val_to_del->Id ) { + return (0, $self->loc("Couldn't find that value")); + } + unless ( $val_to_del->CustomField == $self->Id ) { + return (0, $self->loc("That is not a value for this custom field")); + } + + my $retval = $val_to_del->Delete; + unless ( $retval ) { + return (0, $self->loc("Custom field value could not be deleted")); + } + return ($retval, $self->loc("Custom field value deleted")); +} + + +=head2 ValidateQueue Queue + +Make sure that the name specified is valid + +=cut + +sub ValidateName { + my $self = shift; + my $value = shift; + + return 0 unless length $value; + + return $self->SUPER::ValidateName($value); +} + +=head2 ValidateQueue Queue + +Make sure that the queue specified is a valid queue name + +=cut + +sub ValidateQueue { + my $self = shift; + my $id = shift; + + return undef unless defined $id; + # 0 means "Global" null would _not_ be ok. + return 1 if $id eq '0'; + + my $q = RT::Queue->new( RT->SystemUser ); + $q->Load( $id ); + return undef unless $q->id; + return 1; +} + + + +=head2 Types + +Retuns an array of the types of CustomField that are supported + +=cut + +sub Types { + return (sort {(($FieldTypes{$a}{sort_order}||999) <=> ($FieldTypes{$b}{sort_order}||999)) or ($a cmp $b)} keys %FieldTypes); +} + + +=head2 IsSelectionType + +Retuns a boolean value indicating whether the C<Values> method makes sense +to this Custom Field. + +=cut + +sub IsSelectionType { + my $self = shift; + my $type = @_? shift : $self->Type; + return undef unless $type; + return $FieldTypes{$type}->{selection_type}; +} + + + +=head2 IsExternalValues + +=cut + +sub IsExternalValues { + my $self = shift; + return 0 unless $self->IsSelectionType( @_ ); + return $self->ValuesClass eq 'RT::CustomFieldValues'? 0 : 1; +} + +sub ValuesClass { + my $self = shift; + return $self->_Value( ValuesClass => @_ ) || 'RT::CustomFieldValues'; +} + +sub SetValuesClass { + my $self = shift; + my $class = shift || 'RT::CustomFieldValues'; + + if ( $class eq 'RT::CustomFieldValues' ) { + return $self->_Set( Field => 'ValuesClass', Value => undef, @_ ); + } + + return (0, $self->loc("This Custom Field can not have list of values")) + unless $self->IsSelectionType; + + unless ( $self->ValidateValuesClass( $class ) ) { + return (0, $self->loc("Invalid Custom Field values source")); + } + return $self->_Set( Field => 'ValuesClass', Value => $class, @_ ); +} + +sub ValidateValuesClass { + my $self = shift; + my $class = shift; + + return 1 if !$class || $class eq 'RT::CustomFieldValues'; + return 1 if grep $class eq $_, RT->Config->Get('CustomFieldValuesSources'); + return undef; +} + + +=head2 FriendlyType [TYPE, MAX_VALUES] + +Returns a localized human-readable version of the custom field type. +If a custom field type is specified as the parameter, the friendly type for that type will be returned + +=cut + +sub FriendlyType { + my $self = shift; + + my $type = @_ ? shift : $self->Type; + my $max = @_ ? shift : $self->MaxValues; + $max = 0 unless $max; + + if (my $friendly_type = $FieldTypes{$type}->{labels}->[$max>2 ? 2 : $max]) { + return ( $self->loc( $friendly_type, $max ) ); + } + else { + return ( $self->loc( $type ) ); + } +} + +sub FriendlyTypeComposite { + my $self = shift; + my $composite = shift || $self->TypeComposite; + return $self->FriendlyType(split(/-/, $composite, 2)); +} + + +=head2 ValidateType TYPE + +Takes a single string. returns true if that string is a value +type of custom field + + +=cut + +sub ValidateType { + my $self = shift; + my $type = shift; + + if ( $type =~ s/(?:Single|Multiple)$// ) { + $RT::Logger->warning( "Prefix 'Single' and 'Multiple' to Type deprecated, use MaxValues instead at (". join(":",caller).")"); + } + + if ( $FieldTypes{$type} ) { + return 1; + } + else { + return undef; + } +} + + +sub SetType { + my $self = shift; + my $type = shift; + if ($type =~ s/(?:(Single)|Multiple)$//) { + $RT::Logger->warning("'Single' and 'Multiple' on SetType deprecated, use SetMaxValues instead at (". join(":",caller).")"); + $self->SetMaxValues($1 ? 1 : 0); + } + $self->_Set(Field => 'Type', Value =>$type); +} + +=head2 SetPattern STRING + +Takes a single string representing a regular expression. Performs basic +validation on that regex, and sets the C<Pattern> field for the CF if it +is valid. + +=cut + +sub SetPattern { + my $self = shift; + my $regex = shift; + + my ($ok, $msg) = $self->_IsValidRegex($regex); + if ($ok) { + return $self->_Set(Field => 'Pattern', Value => $regex); + } + else { + return (0, $self->loc("Invalid pattern: [_1]", $msg)); + } +} + +=head2 _IsValidRegex(Str $regex) returns (Bool $success, Str $msg) + +Tests if the string contains an invalid regex. + +=cut + +sub _IsValidRegex { + my $self = shift; + my $regex = shift or return (1, 'valid'); + + local $^W; local $@; + local $SIG{__DIE__} = sub { 1 }; + local $SIG{__WARN__} = sub { 1 }; + + if (eval { qr/$regex/; 1 }) { + return (1, 'valid'); + } + + my $err = $@; + $err =~ s{[,;].*}{}; # strip debug info from error + chomp $err; + return (0, $err); +} + + +=head2 SingleValue + +Returns true if this CustomField only accepts a single value. +Returns false if it accepts multiple values + +=cut + +sub SingleValue { + my $self = shift; + if (($self->MaxValues||0) == 1) { + return 1; + } + else { + return undef; + } +} + +sub UnlimitedValues { + my $self = shift; + if (($self->MaxValues||0) == 0) { + return 1; + } + else { + return undef; + } +} + + +=head2 CurrentUserHasRight RIGHT + +Helper function to call the custom field's queue's CurrentUserHasRight with the passed in args. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return $self->CurrentUser->HasRight( + Object => $self, + Right => $right, + ); +} + +=head2 ACLEquivalenceObjects + +Returns list of objects via which users can get rights on this custom field. For custom fields +these objects can be set using L<ContextObject|/"ContextObject and SetContextObject">. + +=cut + +sub ACLEquivalenceObjects { + my $self = shift; + + my $ctx = $self->ContextObject + or return; + return ($ctx, $ctx->ACLEquivalenceObjects); +} + +=head2 ContextObject and SetContextObject + +Set or get a context for this object. It can be ticket, queue or another object +this CF applies to. Used for ACL control, for example SeeCustomField can be granted on +queue level to allow people to see all fields applied to the queue. + +=cut + +sub SetContextObject { + my $self = shift; + return $self->{'context_object'} = shift; +} + +sub ContextObject { + my $self = shift; + return $self->{'context_object'}; +} + +sub ValidContextType { + my $self = shift; + my $class = shift; + + my %valid; + $valid{$_}++ for split '-', $self->LookupType; + delete $valid{'RT::Transaction'}; + + return $valid{$class}; +} + +=head2 LoadContextObject + +Takes an Id for a Context Object and loads the right kind of RT::Object +for this particular Custom Field (based on the LookupType) and returns it. +This is a good way to ensure you don't try to use a Queue as a Context +Object on a User Custom Field. + +=cut + +sub LoadContextObject { + my $self = shift; + my $type = shift; + my $contextid = shift; + + unless ( $self->ValidContextType($type) ) { + RT->Logger->debug("Invalid ContextType $type for Custom Field ".$self->Id); + return; + } + + my $context_object = $type->new( $self->CurrentUser ); + my ($id, $msg) = $context_object->LoadById( $contextid ); + unless ( $id ) { + RT->Logger->debug("Invalid ContextObject id: $msg"); + return; + } + return $context_object; +} + +=head2 ValidateContextObject + +Ensure that a given ContextObject applies to this Custom Field. +For custom fields that are assigned to Queues or to Classes, this checks that the Custom +Field is actually applied to that objects. For Global Custom Fields, it returns true +as long as the Object is of the right type, because you may be using +your permissions on a given Queue of Class to see a Global CF. +For CFs that are only applied Globally, you don't need a ContextObject. + +=cut + +sub ValidateContextObject { + my $self = shift; + my $object = shift; + + return 1 if $self->IsApplied(0); + + # global only custom fields don't have objects + # that should be used as context objects. + return if $self->ApplyGlobally; + + # Otherwise, make sure we weren't passed a user object that we're + # supposed to treat as a queue. + return unless $self->ValidContextType(ref $object); + + # Check that it is applied correctly + my ($applied_to) = grep {ref($_) eq $self->RecordClassFromLookupType} ($object, $object->ACLEquivalenceObjects); + return unless $applied_to; + return $self->IsApplied($applied_to->id); +} + + +sub _Set { + my $self = shift; + + unless ( $self->CurrentUserHasRight('AdminCustomField') ) { + return ( 0, $self->loc('Permission Denied') ); + } + return $self->SUPER::_Set( @_ ); + +} + + + +=head2 _Value + +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check + +=cut + +sub _Value { + my $self = shift; + return undef unless $self->id; + + # we need to do the rights check + unless ( $self->CurrentUserHasRight('SeeCustomField') ) { + $RT::Logger->debug( + "Permission denied. User #". $self->CurrentUser->id + ." has no SeeCustomField right on CF #". $self->id + ); + return (undef); + } + return $self->__Value( @_ ); +} + + +=head2 SetDisabled + +Takes a boolean. +1 will cause this custom field to no longer be avaialble for objects. +0 will re-enable this field. + +=cut + + +=head2 SetTypeComposite + +Set this custom field's type and maximum values as a composite value + +=cut + +sub SetTypeComposite { + my $self = shift; + my $composite = shift; + + my $old = $self->TypeComposite; + + my ($type, $max_values) = split(/-/, $composite, 2); + if ( $type ne $self->Type ) { + my ($status, $msg) = $self->SetType( $type ); + return ($status, $msg) unless $status; + } + if ( ($max_values || 0) != ($self->MaxValues || 0) ) { + my ($status, $msg) = $self->SetMaxValues( $max_values ); + return ($status, $msg) unless $status; + } + my $render = $self->RenderType; + if ( $render and not grep { $_ eq $render } $self->RenderTypes ) { + # We switched types and our render type is no longer valid, so unset it + # and use the default + $self->SetRenderType( undef ); + } + return 1, $self->loc( + "Type changed from '[_1]' to '[_2]'", + $self->FriendlyTypeComposite( $old ), + $self->FriendlyTypeComposite( $composite ), + ); +} + +=head2 TypeComposite + +Returns a composite value composed of this object's type and maximum values + +=cut + + +sub TypeComposite { + my $self = shift; + return join '-', ($self->Type || ''), ($self->MaxValues || 0); +} + +=head2 TypeComposites + +Returns an array of all possible composite values for custom fields. + +=cut + +sub TypeComposites { + my $self = shift; + return grep !/(?:[Tt]ext|Combobox|Date|DateTime|TimeValue)-0/, map { ("$_-1", "$_-0") } $self->Types; +} + +=head2 RenderType + +Returns the type of form widget to render for this custom field. Currently +this only affects fields which return true for L</HasRenderTypes>. + +=cut + +sub RenderType { + my $self = shift; + return '' unless $self->HasRenderTypes; + + return $self->_Value( 'RenderType', @_ ) + || $self->DefaultRenderType; +} + +=head2 SetRenderType TYPE + +Sets this custom field's render type. + +=cut + +sub SetRenderType { + my $self = shift; + my $type = shift; + return (0, $self->loc("This custom field has no Render Types")) + unless $self->HasRenderTypes; + + if ( !$type || $type eq $self->DefaultRenderType ) { + return $self->_Set( Field => 'RenderType', Value => undef, @_ ); + } + + if ( not grep { $_ eq $type } $self->RenderTypes ) { + return (0, $self->loc("Invalid Render Type for custom field of type [_1]", + $self->FriendlyType)); + } + + return $self->_Set( Field => 'RenderType', Value => $type, @_ ); +} + +=head2 DefaultRenderType [TYPE COMPOSITE] + +Returns the default render type for this custom field's type or the TYPE +COMPOSITE specified as an argument. + +=cut + +sub DefaultRenderType { + my $self = shift; + my $composite = @_ ? shift : $self->TypeComposite; + my ($type, $max) = split /-/, $composite, 2; + return unless $type and $self->HasRenderTypes($composite); + return $FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }[0]; +} + +=head2 HasRenderTypes [TYPE_COMPOSITE] + +Returns a boolean value indicating whether the L</RenderTypes> and +L</RenderType> methods make sense for this custom field. + +Currently true only for type C<Select>. + +=cut + +sub HasRenderTypes { + my $self = shift; + my ($type, $max) = split /-/, (@_ ? shift : $self->TypeComposite), 2; + return undef unless $type; + return defined $FieldTypes{$type}->{render_types} + ->{ $max == 1 ? 'single' : 'multiple' }; +} + +=head2 RenderTypes [TYPE COMPOSITE] + +Returns the valid render types for this custom field's type or the TYPE +COMPOSITE specified as an argument. + +=cut + +sub RenderTypes { + my $self = shift; + my $composite = @_ ? shift : $self->TypeComposite; + my ($type, $max) = split /-/, $composite, 2; + return unless $type and $self->HasRenderTypes($composite); + return @{$FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }}; +} + +=head2 SetLookupType + +Autrijus: care to doc how LookupTypes work? + +=cut + +sub SetLookupType { + my $self = shift; + my $lookup = shift; + if ( $lookup ne $self->LookupType ) { + # Okay... We need to invalidate our existing relationships + my $ObjectCustomFields = RT::ObjectCustomFields->new($self->CurrentUser); + $ObjectCustomFields->LimitToCustomField($self->Id); + $_->Delete foreach @{$ObjectCustomFields->ItemsArrayRef}; + } + return $self->_Set(Field => 'LookupType', Value =>$lookup); +} + +=head2 LookupTypes + +Returns an array of LookupTypes available + +=cut + + +sub LookupTypes { + my $self = shift; + return sort keys %FRIENDLY_OBJECT_TYPES; +} + +my @FriendlyObjectTypes = ( + "[_1] objects", # loc + "[_1]'s [_2] objects", # loc + "[_1]'s [_2]'s [_3] objects", # loc +); + +=head2 FriendlyLookupType + +Returns a localized description of the type of this custom field + +=cut + +sub FriendlyLookupType { + my $self = shift; + my $lookup = shift || $self->LookupType; + + return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} )) + if (defined $FRIENDLY_OBJECT_TYPES{$lookup} ); + + my @types = map { s/^RT::// ? $self->loc($_) : $_ } + grep { defined and length } + split( /-/, $lookup ) + or return; + return ( $self->loc( $FriendlyObjectTypes[$#types], @types ) ); +} + +=head1 RecordClassFromLookupType + +Returns the type of Object referred to by ObjectCustomFields' ObjectId column + +Optionally takes a LookupType to use instead of using the value on the loaded +record. In this case, the method may be called on the class instead of an +object. + +=cut + +sub RecordClassFromLookupType { + my $self = shift; + my $type = shift || $self->LookupType; + my ($class) = ($type =~ /^([^-]+)/); + unless ( $class ) { + if (blessed($self) and $self->LookupType eq $type) { + $RT::Logger->error( + "Custom Field #". $self->id + ." has incorrect LookupType '$type'" + ); + } else { + RT->Logger->error("Invalid LookupType passed as argument: $type"); + } + return undef; + } + return $class; +} + +=head1 ObjectTypeFromLookupType + +Returns the ObjectType used in ObjectCustomFieldValues rows for this CF + +Optionally takes a LookupType to use instead of using the value on the loaded +record. In this case, the method may be called on the class instead of an +object. + +=cut + +sub ObjectTypeFromLookupType { + my $self = shift; + my $type = shift || $self->LookupType; + my ($class) = ($type =~ /([^-]+)$/); + unless ( $class ) { + if (blessed($self) and $self->LookupType eq $type) { + $RT::Logger->error( + "Custom Field #". $self->id + ." has incorrect LookupType '$type'" + ); + } else { + RT->Logger->error("Invalid LookupType passed as argument: $type"); + } + return undef; + } + return $class; +} + +sub CollectionClassFromLookupType { + my $self = shift; + + my $record_class = $self->RecordClassFromLookupType; + return undef unless $record_class; + + my $collection_class; + if ( UNIVERSAL::can($record_class.'Collection', 'new') ) { + $collection_class = $record_class.'Collection'; + } elsif ( UNIVERSAL::can($record_class.'es', 'new') ) { + $collection_class = $record_class.'es'; + } elsif ( UNIVERSAL::can($record_class.'s', 'new') ) { + $collection_class = $record_class.'s'; + } else { + $RT::Logger->error("Can not find a collection class for record class '$record_class'"); + return undef; + } + return $collection_class; +} + +=head1 ApplyGlobally + +Certain custom fields (users, groups) should only be applied globally +but rather than regexing in code for LookupType =~ RT::Queue, we'll codify +the rules here. + +=cut + +sub ApplyGlobally { + my $self = shift; + + return ($self->LookupType =~ /^RT::(?:Group|User)/io); + +} + +=head1 AppliedTo + +Returns collection with objects this custom field is applied to. +Class of the collection depends on L</LookupType>. +See all L</NotAppliedTo> . + +Doesn't takes into account if object is applied globally. + +=cut + +sub AppliedTo { + my $self = shift; + + my ($res, $ocfs_alias) = $self->_AppliedTo; + return $res unless $res; + + $res->Limit( + ALIAS => $ocfs_alias, + FIELD => 'id', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + + return $res; +} + +=head1 NotAppliedTo + +Returns collection with objects this custom field is not applied to. +Class of the collection depends on L</LookupType>. +See all L</AppliedTo> . + +Doesn't takes into account if object is applied globally. + +=cut + +sub NotAppliedTo { + my $self = shift; + + my ($res, $ocfs_alias) = $self->_AppliedTo; + return $res unless $res; + + $res->Limit( + ALIAS => $ocfs_alias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + + return $res; +} + +sub _AppliedTo { + my $self = shift; + + my ($class) = $self->CollectionClassFromLookupType; + return undef unless $class; + + my $res = $class->new( $self->CurrentUser ); + + # If CF is a Group CF, only display user-defined groups + if ( $class eq 'RT::Groups' ) { + $res->LimitToUserDefinedGroups; + } + + $res->OrderBy( FIELD => 'Name' ); + my $ocfs_alias = $res->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'ObjectCustomFields', + FIELD2 => 'ObjectId', + ); + $res->Limit( + LEFTJOIN => $ocfs_alias, + ALIAS => $ocfs_alias, + FIELD => 'CustomField', + VALUE => $self->id, + ); + return ($res, $ocfs_alias); +} + +=head2 IsApplied + +Takes object id and returns corresponding L<RT::ObjectCustomField> +record if this custom field is applied to the object. Use 0 to check +if custom field is applied globally. + +=cut + +sub IsApplied { + my $self = shift; + my $id = shift; + my $ocf = RT::ObjectCustomField->new( $self->CurrentUser ); + $ocf->LoadByCols( CustomField => $self->id, ObjectId => $id || 0 ); + return undef unless $ocf->id; + return $ocf; +} + +=head2 AddToObject OBJECT + +Add this custom field as a custom field for a single object, such as a queue or group. + +Takes an object + +=cut + + +sub AddToObject { + my $self = shift; + my $object = shift; + my $id = $object->Id || 0; + + unless (index($self->LookupType, ref($object)) == 0) { + return ( 0, $self->loc('Lookup type mismatch') ); + } + + unless ( $object->CurrentUserHasRight('AssignCustomFields') ) { + return ( 0, $self->loc('Permission Denied') ); + } + + if ( $self->IsApplied( $id ) ) { + return ( 0, $self->loc("Custom field is already applied to the object") ); + } + + if ( $id ) { + # applying locally + return (0, $self->loc("Couldn't apply custom field to an object as it's global already") ) + if $self->IsApplied( 0 ); + } + else { + my $applied = RT::ObjectCustomFields->new( $self->CurrentUser ); + $applied->LimitToCustomField( $self->id ); + while ( my $record = $applied->Next ) { + $record->Delete; + } + } + + my $ocf = RT::ObjectCustomField->new( $self->CurrentUser ); + my ( $oid, $msg ) = $ocf->Create( + ObjectId => $id, CustomField => $self->id, + ); + return ( $oid, $msg ); +} + + +=head2 RemoveFromObject OBJECT + +Remove this custom field for a single object, such as a queue or group. + +Takes an object + +=cut + +sub RemoveFromObject { + my $self = shift; + my $object = shift; + my $id = $object->Id || 0; + + unless (index($self->LookupType, ref($object)) == 0) { + return ( 0, $self->loc('Object type mismatch') ); + } + + unless ( $object->CurrentUserHasRight('AssignCustomFields') ) { + return ( 0, $self->loc('Permission Denied') ); + } + + my $ocf = $self->IsApplied( $id ); + unless ( $ocf ) { + return ( 0, $self->loc("This custom field does not apply to that object") ); + } + + # XXX: Delete doesn't return anything + my ( $oid, $msg ) = $ocf->Delete; + return ( $oid, $msg ); +} + + +=head2 AddValueForObject HASH + +Adds a custom field value for a record object of some kind. +Takes a param hash of + +Required: + + Object + Content + +Optional: + + LargeContent + ContentType + +=cut + +sub AddValueForObject { + my $self = shift; + my %args = ( + Object => undef, + Content => undef, + LargeContent => undef, + ContentType => undef, + @_ + ); + my $obj = $args{'Object'} or return ( 0, $self->loc('Invalid object') ); + + unless ( $self->CurrentUserHasRight('ModifyCustomField') ) { + return ( 0, $self->loc('Permission Denied') ); + } + + unless ( $self->MatchPattern($args{'Content'}) ) { + return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) ); + } + + $RT::Handle->BeginTransaction; + + if ( $self->MaxValues ) { + my $current_values = $self->ValuesForObject($obj); + my $extra_values = ( $current_values->Count + 1 ) - $self->MaxValues; + + # (The +1 is for the new value we're adding) + + # If we have a set of current values and we've gone over the maximum + # allowed number of values, we'll need to delete some to make room. + # which former values are blown away is not guaranteed + + while ($extra_values) { + my $extra_item = $current_values->Next; + unless ( $extra_item->id ) { + $RT::Logger->crit( "We were just asked to delete " + ."a custom field value that doesn't exist!" ); + $RT::Handle->Rollback(); + return (undef); + } + $extra_item->Delete; + $extra_values--; + } + } + + if (my $canonicalizer = $self->can('_CanonicalizeValue'.$self->Type)) { + $canonicalizer->($self, \%args); + } + + + + my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser ); + my ($val, $msg) = $newval->Create( + ObjectType => ref($obj), + ObjectId => $obj->Id, + Content => $args{'Content'}, + LargeContent => $args{'LargeContent'}, + ContentType => $args{'ContentType'}, + CustomField => $self->Id + ); + + unless ($val) { + $RT::Handle->Rollback(); + return ($val, $self->loc("Couldn't create record: [_1]", $msg)); + } + + $RT::Handle->Commit(); + return ($val); + +} + + + +sub _CanonicalizeValueDateTime { + my $self = shift; + my $args = shift; + my $DateObj = RT::Date->new( $self->CurrentUser ); + $DateObj->Set( Format => 'unknown', + Value => $args->{'Content'} ); + $args->{'Content'} = $DateObj->ISO; +} + +# For date, we need to store Content as ISO date +sub _CanonicalizeValueDate { + my $self = shift; + my $args = shift; + + # in case user input date with time, let's omit it by setting timezone + # to utc so "hour" won't affect "day" + my $DateObj = RT::Date->new( $self->CurrentUser ); + $DateObj->Set( Format => 'unknown', + Value => $args->{'Content'}, + ); + $args->{'Content'} = $DateObj->Date( Timezone => 'user' ); +} + +=head2 MatchPattern STRING + +Tests the incoming string against the Pattern of this custom field object +and returns a boolean; returns true if the Pattern is empty. + +=cut + +sub MatchPattern { + my $self = shift; + my $regex = $self->Pattern or return 1; + + return (( defined $_[0] ? $_[0] : '') =~ $regex); +} + + + + +=head2 FriendlyPattern + +Prettify the pattern of this custom field, by taking the text in C<(?#text)> +and localizing it. + +=cut + +sub FriendlyPattern { + my $self = shift; + my $regex = $self->Pattern; + + return '' unless length $regex; + if ( $regex =~ /\(\?#([^)]*)\)/ ) { + return '[' . $self->loc($1) . ']'; + } + else { + return $regex; + } +} + + + + +=head2 DeleteValueForObject HASH + +Deletes a custom field value for a ticket. Takes a param hash of Object and Content + +Returns a tuple of (STATUS, MESSAGE). If the call succeeded, the STATUS is true. otherwise it's false + +=cut + +sub DeleteValueForObject { + my $self = shift; + my %args = ( Object => undef, + Content => undef, + Id => undef, + @_ ); + + + unless ($self->CurrentUserHasRight('ModifyCustomField')) { + return (0, $self->loc('Permission Denied')); + } + + my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser); + + if (my $id = $args{'Id'}) { + $oldval->Load($id); + } + unless ($oldval->id) { + $oldval->LoadByObjectContentAndCustomField( + Object => $args{'Object'}, + Content => $args{'Content'}, + CustomField => $self->Id, + ); + } + + + # check to make sure we found it + unless ($oldval->Id) { + return(0, $self->loc("Custom field value [_1] could not be found for custom field [_2]", $args{'Content'}, $self->Name)); + } + + # for single-value fields, we need to validate that empty string is a valid value for it + if ( $self->SingleValue and not $self->MatchPattern( '' ) ) { + return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) ); + } + + # delete it + + my $ret = $oldval->Delete(); + unless ($ret) { + return(0, $self->loc("Custom field value could not be found")); + } + return($oldval->Id, $self->loc("Custom field value deleted")); +} + + +=head2 ValuesForObject OBJECT + +Return an L<RT::ObjectCustomFieldValues> object containing all of this custom field's values for OBJECT + +=cut + +sub ValuesForObject { + my $self = shift; + my $object = shift; + + my $values = RT::ObjectCustomFieldValues->new($self->CurrentUser); + unless ($self->id and $self->CurrentUserHasRight('SeeCustomField')) { + # Return an empty object if they have no rights to see + $values->Limit( FIELD => "id", VALUE => 0, SUBCLAUSE => "ACL" ); + return ($values); + } + + $values->LimitToCustomField($self->Id); + $values->LimitToObject($object); + + return ($values); +} + + +=head2 _ForObjectType PATH FRIENDLYNAME + +Tell RT that a certain object accepts custom fields + +Examples: + + 'RT::Queue-RT::Ticket' => "Tickets", # loc + 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", # loc + 'RT::User' => "Users", # loc + 'RT::Group' => "Groups", # loc + 'RT::Queue' => "Queues", # loc + +This is a class method. + +=cut + +sub _ForObjectType { + my $self = shift; + my $path = shift; + my $friendly_name = shift; + + $FRIENDLY_OBJECT_TYPES{$path} = $friendly_name; + +} + + +=head2 IncludeContentForValue [VALUE] (and SetIncludeContentForValue) + +Gets or sets the C<IncludeContentForValue> for this custom field. RT +uses this field to automatically include content into the user's browser +as they display records with custom fields in RT. + +=cut + +sub SetIncludeContentForValue { + shift->IncludeContentForValue(@_); +} +sub IncludeContentForValue{ + my $self = shift; + $self->_URLTemplate('IncludeContentForValue', @_); +} + + + +=head2 LinkValueTo [VALUE] (and SetLinkValueTo) + +Gets or sets the C<LinkValueTo> for this custom field. RT +uses this field to make custom field values into hyperlinks in the user's +browser as they display records with custom fields in RT. + +=cut + + +sub SetLinkValueTo { + shift->LinkValueTo(@_); +} + +sub LinkValueTo { + my $self = shift; + $self->_URLTemplate('LinkValueTo', @_); + +} + + +=head2 _URLTemplate NAME [VALUE] + +With one argument, returns the _URLTemplate named C<NAME>, but only if +the current user has the right to see this custom field. + +With two arguments, attemptes to set the relevant template value. + +=cut + +sub _URLTemplate { + my $self = shift; + my $template_name = shift; + if (@_) { + + my $value = shift; + unless ( $self->CurrentUserHasRight('AdminCustomField') ) { + return ( 0, $self->loc('Permission Denied') ); + } + $self->SetAttribute( Name => $template_name, Content => $value ); + return ( 1, $self->loc('Updated') ); + } else { + unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) { + return (undef); + } + + my @attr = $self->Attributes->Named($template_name); + my $attr = shift @attr; + + if ($attr) { return $attr->Content } + + } +} + +sub SetBasedOn { + my $self = shift; + my $value = shift; + + return $self->_Set( Field => 'BasedOn', Value => $value, @_ ) + unless defined $value and length $value; + + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->SetContextObject( $self->ContextObject ); + $cf->Load( ref $value ? $value->id : $value ); + + return (0, "Permission denied") + unless $cf->id && $cf->CurrentUserHasRight('SeeCustomField'); + + # XXX: Remove this restriction once we support lists and cascaded selects + if ( $self->RenderType =~ /List/ ) { + return (0, $self->loc("We can't currently render as a List when basing categories on another custom field. Please use another render type.")); + } + + return $self->_Set( Field => 'BasedOn', Value => $value, @_ ) +} + +sub BasedOnObj { + my $self = shift; + + my $obj = RT::CustomField->new( $self->CurrentUser ); + $obj->SetContextObject( $self->ContextObject ); + if ( $self->BasedOn ) { + $obj->Load( $self->BasedOn ); + } + return $obj; +} + +sub UILocation { + my $self = shift; + my $tag = $self->FirstAttribute( 'UILocation' ); + return $tag ? $tag->Content : ''; +} + +sub SetUILocation { + my $self = shift; + my $tag = shift; + if ( $tag ) { + return $self->SetAttribute( Name => 'UILocation', Content => $tag ); + } + else { + return $self->DeleteAttribute('UILocation'); + } +} + +sub NoClone { + my $self = shift; + $self->FirstAttribute('NoClone') ? 1 : ''; +} + +sub SetNoClone { + my $self = shift; + my $value = shift; + if ( $value ) { + return $self->SetAttribute( Name => 'NoClone', Content => 1 ); + } else { + return $self->DeleteAttribute('NoClone'); + } +} + + +=head2 id + +Returns the current value of id. +(In the database, id is stored as int(11).) + + +=cut + + +=head2 Name + +Returns the current value of Name. +(In the database, Name is stored as varchar(200).) + + + +=head2 SetName VALUE + + +Set Name to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Name will be stored as a varchar(200).) + + +=cut + + +=head2 Type + +Returns the current value of Type. +(In the database, Type is stored as varchar(200).) + + + +=head2 SetType VALUE + + +Set Type to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Type will be stored as a varchar(200).) + + +=cut + + +=head2 RenderType + +Returns the current value of RenderType. +(In the database, RenderType is stored as varchar(64).) + + + +=head2 SetRenderType VALUE + + +Set RenderType to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, RenderType will be stored as a varchar(64).) + + +=cut + + +=head2 MaxValues + +Returns the current value of MaxValues. +(In the database, MaxValues is stored as int(11).) + + + +=head2 SetMaxValues VALUE + + +Set MaxValues to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, MaxValues will be stored as a int(11).) + + +=cut + + +=head2 Pattern + +Returns the current value of Pattern. +(In the database, Pattern is stored as text.) + + + +=head2 SetPattern VALUE + + +Set Pattern to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Pattern will be stored as a text.) + + +=cut + + +=head2 Repeated + +Returns the current value of Repeated. +(In the database, Repeated is stored as smallint(6).) + + + +=head2 SetRepeated VALUE + + +Set Repeated to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Repeated will be stored as a smallint(6).) + + +=cut + + +=head2 BasedOn + +Returns the current value of BasedOn. +(In the database, BasedOn is stored as int(11).) + + + +=head2 SetBasedOn VALUE + + +Set BasedOn to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, BasedOn will be stored as a int(11).) + + +=cut + + +=head2 Description + +Returns the current value of Description. +(In the database, Description is stored as varchar(255).) + + + +=head2 SetDescription VALUE + + +Set Description to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Description will be stored as a varchar(255).) + + +=cut + + +=head2 SortOrder + +Returns the current value of SortOrder. +(In the database, SortOrder is stored as int(11).) + + + +=head2 SetSortOrder VALUE + + +Set SortOrder to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, SortOrder will be stored as a int(11).) + + +=cut + + +=head2 LookupType + +Returns the current value of LookupType. +(In the database, LookupType is stored as varchar(255).) + + + +=head2 SetLookupType VALUE + + +Set LookupType to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, LookupType will be stored as a varchar(255).) + + +=cut + + +=head2 Creator + +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) + + +=cut + + +=head2 Created + +Returns the current value of Created. +(In the database, Created is stored as datetime.) + + +=cut + + +=head2 LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=head2 LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) + + +=cut + + +=head2 Disabled + +Returns the current value of Disabled. +(In the database, Disabled is stored as smallint(6).) + + + +=head2 SetDisabled VALUE + + +Set Disabled to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Disabled will be stored as a smallint(6).) + + +=cut + + + +sub _CoreAccessible { + { + + id => + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + Name => + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, + Type => + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, + RenderType => + {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, + MaxValues => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + Pattern => + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + Repeated => + {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, + ValuesClass => + {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, + BasedOn => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + Description => + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, + SortOrder => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + LookupType => + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, + Creator => + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Created => + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + LastUpdatedBy => + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + LastUpdated => + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Disabled => + {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, + + } +}; + + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Dashboard/Mailer.pm b/rt/lib/RT/Dashboard/Mailer.pm index eb620e65d..038cf4593 100644 --- a/rt/lib/RT/Dashboard/Mailer.pm +++ b/rt/lib/RT/Dashboard/Mailer.pm @@ -382,9 +382,14 @@ sub BuildEmail { $cid_of{$uri} = time() . $$ . int(rand(1e6)); my ($data, $filename, $mimetype, $encoding) = GetResource($uri); - # downgrade non-text strings, because all strings are utf8 by - # default, which is wrong for non-text strings. - if ( $mimetype !~ m{text/} ) { + # Encode textual data in UTF-8, and downgrade (treat + # codepoints as codepoints, and ensure the UTF-8 flag is + # off) everything else. + my @extra; + if ( $mimetype =~ m{text/} ) { + $data = Encode::encode( "UTF-8", $data ); + @extra = ( Charset => "UTF-8" ); + } else { utf8::downgrade( $data, 1 ) or $RT::Logger->warning("downgrade $data failed"); } @@ -396,6 +401,7 @@ sub BuildEmail { Disposition => 'inline', Name => RT::Interface::Email::EncodeToMIME( String => $filename ), 'Content-Id' => $cid_of{$uri}, + @extra, ); return "cid:$cid_of{$uri}"; @@ -409,16 +415,16 @@ sub BuildEmail { ); my $entity = MIME::Entity->build( - From => Encode::encode_utf8($args{From}), - To => Encode::encode_utf8($args{To}), + From => Encode::encode("UTF-8", $args{From}), + To => Encode::encode("UTF-8", $args{To}), Subject => RT::Interface::Email::EncodeToMIME( String => $args{Subject} ), Type => "multipart/mixed", ); $entity->attach( - Data => Encode::encode_utf8($content), Type => 'text/html', Charset => 'UTF-8', + Data => Encode::encode("UTF-8", $content), Disposition => 'inline', Encoding => "base64", ); @@ -547,6 +553,9 @@ sub GetResource { for ($k, $v) { s/%(..)/chr hex $1/ge } + # Decode from bytes to characters + $_ = Encode::decode( "UTF-8", $_ ) for $k, $v; + # no value yet, simple key=value if (!exists $args{$k}) { $args{$k} = $v; diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm index 89f7ea4f9..630730abd 100644 --- a/rt/lib/RT/EmailParser.pm +++ b/rt/lib/RT/EmailParser.pm @@ -299,8 +299,8 @@ sub ParseCcAddressesFromHead { my (@Addresses); - my @ToObjs = Email::Address->parse( $self->Head->get('To') ); - my @CcObjs = Email::Address->parse( $self->Head->get('Cc') ); + my @ToObjs = Email::Address->parse( Encode::decode( "UTF-8", $self->Head->get('To') ) ); + my @CcObjs = Email::Address->parse( Encode::decode( "UTF-8", $self->Head->get('Cc') ) ); foreach my $AddrObj ( @ToObjs, @CcObjs ) { my $Address = $AddrObj->address; @@ -618,7 +618,7 @@ sub RescueOutlook { # Add base64 since we've seen examples of double newlines with # this type too. Need an example of a multi-part base64 to # handle that permutation if it exists. - elsif ( $mime->head->get('Content-Transfer-Encoding') =~ m{base64} ) { + elsif ( ($mime->head->get('Content-Transfer-Encoding')||'') =~ m{base64} ) { $text_part = $mime; # Assuming single part, already decoded. } diff --git a/rt/lib/RT/EmailParser.pm.orig b/rt/lib/RT/EmailParser.pm.orig new file mode 100644 index 000000000..89f7ea4f9 --- /dev/null +++ b/rt/lib/RT/EmailParser.pm.orig @@ -0,0 +1,692 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +package RT::EmailParser; + + +use base qw/RT::Base/; + +use strict; +use warnings; + + +use Email::Address; +use MIME::Entity; +use MIME::Head; +use MIME::Parser; +use File::Temp qw/tempdir/; + +=head1 NAME + + RT::EmailParser - helper functions for parsing parts from incoming + email messages + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + + + +=head1 METHODS + +=head2 new + +Returns a new RT::EmailParser object + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + return $self; +} + + +=head2 SmartParseMIMEEntityFromScalar Message => SCALAR_REF [, Decode => BOOL, Exact => BOOL ] } + +Parse a message stored in a scalar from scalar_ref. + +=cut + +sub SmartParseMIMEEntityFromScalar { + my $self = shift; + my %args = ( Message => undef, Decode => 1, Exact => 0, @_ ); + + eval { + my ( $fh, $temp_file ); + for ( 1 .. 10 ) { + + # on NFS and NTFS, it is possible that tempfile() conflicts + # with other processes, causing a race condition. we try to + # accommodate this by pausing and retrying. + last + if ( $fh, $temp_file ) = + eval { File::Temp::tempfile( UNLINK => 0 ) }; + sleep 1; + } + if ($fh) { + + #thank you, windows + binmode $fh; + $fh->autoflush(1); + print $fh $args{'Message'}; + close($fh); + if ( -f $temp_file ) { + + # We have to trust the temp file's name -- untaint it + $temp_file =~ /(.*)/; + my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} ); + unlink($1); + return $entity; + } + } + }; + + #If for some reason we weren't able to parse the message using a temp file + # try it with a scalar + if ( $@ || !$self->Entity ) { + return $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'}, $args{'Exact'} ); + } + +} + + +=head2 ParseMIMEEntityFromSTDIN + +Parse a message from standard input + +=cut + +sub ParseMIMEEntityFromSTDIN { + my $self = shift; + return $self->ParseMIMEEntityFromFileHandle(\*STDIN, @_); +} + +=head2 ParseMIMEEntityFromScalar $message + +Takes either a scalar or a reference to a scalar which contains a stringified MIME message. +Parses it. + +Returns true if it wins. +Returns false if it loses. + +=cut + +sub ParseMIMEEntityFromScalar { + my $self = shift; + return $self->_ParseMIMEEntity( shift, 'parse_data', @_ ); +} + +=head2 ParseMIMEEntityFromFilehandle *FH + +Parses a mime entity from a filehandle passed in as an argument + +=cut + +sub ParseMIMEEntityFromFileHandle { + my $self = shift; + return $self->_ParseMIMEEntity( shift, 'parse', @_ ); +} + +=head2 ParseMIMEEntityFromFile + +Parses a mime entity from a filename passed in as an argument + +=cut + +sub ParseMIMEEntityFromFile { + my $self = shift; + return $self->_ParseMIMEEntity( shift, 'parse_open', @_ ); +} + + +sub _ParseMIMEEntity { + my $self = shift; + my $message = shift; + my $method = shift; + my $postprocess = (@_ ? shift : 1); + my $exact = shift; + + # Create a new parser object: + my $parser = MIME::Parser->new(); + $self->_SetupMIMEParser($parser); + $parser->decode_bodies(0) if $exact; + + # TODO: XXX 3.0 we really need to wrap this in an eval { } + unless ( $self->{'entity'} = $parser->$method($message) ) { + $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages"); + # Try again, this time without extracting nested messages + $parser->extract_nested_messages(0); + unless ( $self->{'entity'} = $parser->$method($message) ) { + $RT::Logger->crit("couldn't parse MIME stream"); + return ( undef); + } + } + + $self->_PostProcessNewEntity if $postprocess; + + return $self->{'entity'}; +} + +sub _DecodeBodies { + my $self = shift; + return unless $self->{'entity'}; + + my @parts = $self->{'entity'}->parts_DFS; + $self->_DecodeBody($_) foreach @parts; +} + +sub _DecodeBody { + my $self = shift; + my $entity = shift; + + my $old = $entity->bodyhandle or return; + return unless $old->is_encoded; + + require MIME::Decoder; + my $encoding = $entity->head->mime_encoding; + my $decoder = MIME::Decoder->new($encoding); + unless ( $decoder ) { + $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary"); + $old->is_encoded(0); + return; + } + + require MIME::Body; + # XXX: use InCore for now, but later must switch to files + my $new = MIME::Body::InCore->new(); + $new->binmode(1); + $new->is_encoded(0); + + my $source = $old->open('r') or die "couldn't open body: $!"; + my $destination = $new->open('w') or die "couldn't open body: $!"; + { + local $@; + eval { $decoder->decode($source, $destination) }; + $RT::Logger->error($@) if $@; + } + $source->close or die "can't close: $!"; + $destination->close or die "can't close: $!"; + + $entity->bodyhandle( $new ); +} + +=head2 _PostProcessNewEntity + +cleans up and postprocesses a newly parsed MIME Entity + +=cut + +sub _PostProcessNewEntity { + my $self = shift; + + #Now we've got a parsed mime object. + + # Unfold headers that are have embedded newlines + # Better do this before conversion or it will break + # with multiline encoded Subject (RFC2047) (fsck.com #5594) + $self->Head->unfold; + + # try to convert text parts into utf-8 charset + RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8'); +} + +=head2 ParseCcAddressesFromHead HASHREF + +Takes a hashref object containing QueueObj, Head and CurrentUser objects. +Returns a list of all email addresses in the To and Cc +headers b<except> the current Queue's email addresses, the CurrentUser's +email address and anything that the RT->Config->Get('RTAddressRegexp') matches. + +=cut + +sub ParseCcAddressesFromHead { + my $self = shift; + my %args = ( + QueueObj => undef, + CurrentUser => undef, + @_ + ); + + my (@Addresses); + + my @ToObjs = Email::Address->parse( $self->Head->get('To') ); + my @CcObjs = Email::Address->parse( $self->Head->get('Cc') ); + + foreach my $AddrObj ( @ToObjs, @CcObjs ) { + my $Address = $AddrObj->address; + my $user = RT::User->new(RT->SystemUser); + $Address = $user->CanonicalizeEmailAddress($Address); + next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address; + next if $self->IsRTAddress($Address); + + push ( @Addresses, $Address ); + } + return (@Addresses); +} + + +=head2 IsRTaddress ADDRESS + +Takes a single parameter, an email address. +Returns true if that address matches the C<RTAddressRegexp> config option. +Returns false, otherwise. + + +=cut + +sub IsRTAddress { + my $self = shift; + my $address = shift; + + if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) { + return $address =~ /$address_re/i ? 1 : undef; + } + + # we don't warn here, but do in config check + if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) { + return 1 if lc $correspond_address eq lc $address; + } + if ( my $comment_address = RT->Config->Get('CommentAddress') ) { + return 1 if lc $comment_address eq lc $address; + } + + my $queue = RT::Queue->new( RT->SystemUser ); + $queue->LoadByCols( CorrespondAddress => $address ); + return 1 if $queue->id; + + $queue->LoadByCols( CommentAddress => $address ); + return 1 if $queue->id; + + return undef; +} + + +=head2 CullRTAddresses ARRAY + +Takes a single argument, an array of email addresses. +Returns the same array with any IsRTAddress()es weeded out. + + +=cut + +sub CullRTAddresses { + my $self = shift; + my @addresses = (@_); + + return grep { !$self->IsRTAddress($_) } @addresses; +} + + + + + +# LookupExternalUserInfo is a site-definable method for synchronizing +# incoming users with an external data source. +# +# This routine takes a tuple of EmailAddress and FriendlyName +# EmailAddress is the user's email address, ususally taken from +# an email message's From: header. +# FriendlyName is a freeform string, ususally taken from the "comment" +# portion of an email message's From: header. +# +# If you define an AutoRejectRequest template, RT will use this +# template for the rejection message. + + +=head2 LookupExternalUserInfo + + LookupExternalUserInfo is a site-definable method for synchronizing + incoming users with an external data source. + + This routine takes a tuple of EmailAddress and FriendlyName + EmailAddress is the user's email address, ususally taken from + an email message's From: header. + FriendlyName is a freeform string, ususally taken from the "comment" + portion of an email message's From: header. + + It returns (FoundInExternalDatabase, ParamHash); + + FoundInExternalDatabase must be set to 1 before return if the user + was found in the external database. + + ParamHash is a Perl parameter hash which can contain at least the + following fields. These fields are used to populate RT's users + database when the user is created. + + EmailAddress is the email address that RT should use for this user. + Name is the 'Name' attribute RT should use for this user. + 'Name' is used for things like access control and user lookups. + RealName is what RT should display as the user's name when displaying + 'friendly' names + +=cut + +sub LookupExternalUserInfo { + my $self = shift; + my $EmailAddress = shift; + my $RealName = shift; + + my $FoundInExternalDatabase = 1; + my %params; + + #Name is the RT username you want to use for this user. + $params{'Name'} = $EmailAddress; + $params{'EmailAddress'} = $EmailAddress; + $params{'RealName'} = $RealName; + + return ($FoundInExternalDatabase, %params); +} + +=head2 Head + +Return the parsed head from this message + +=cut + +sub Head { + my $self = shift; + return $self->Entity->head; +} + +=head2 Entity + +Return the parsed Entity from this message + +=cut + +sub Entity { + my $self = shift; + return $self->{'entity'}; +} + + + +=head2 _SetupMIMEParser $parser + +A private instance method which sets up a mime parser to do its job + +=cut + + + ## TODO: Does it make sense storing to disk at all? After all, we + ## need to put each msg as an in-core scalar before saving it to + ## the database, don't we? + + ## At the same time, we should make sure that we nuke attachments + ## Over max size and return them + +sub _SetupMIMEParser { + my $self = shift; + my $parser = shift; + + # Set up output directory for files; we use $RT::VarPath instead + # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always + # writable. + my $tmpdir; + if ( -w $RT::VarPath ) { + $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 ); + } elsif (-w File::Spec->tmpdir) { + $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 ); + } else { + $RT::Logger->crit("Neither the RT var directory ($RT::VarPath) nor the system tmpdir (@{[File::Spec->tmpdir]}) are writable; falling back to in-memory parsing!"); + } + + #If someone includes a message, extract it + $parser->extract_nested_messages(1); + $parser->extract_uuencode(1); ### default is false + + if ($tmpdir) { + # If we got a writable tmpdir, write to disk + push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir ); + $parser->output_dir($tmpdir); + $parser->filer->ignore_filename(1); + + # Set up the prefix for files with auto-generated names: + $parser->output_prefix("part"); + + # From the MIME::Parser docs: + # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope" + # Turns out that the default is to recycle tempfiles + # Temp files should never be recycled, especially when running under perl taint checking + + $parser->tmp_recycling(0) if $parser->can('tmp_recycling'); + } else { + # Otherwise, fall back to storing it in memory + $parser->output_to_core(1); + $parser->tmp_to_core(1); + $parser->use_inner_files(1); + } + +} + +=head2 ParseEmailAddress string + +Returns a list of Email::Address objects +Works around the bug that Email::Address 1.889 and earlier +doesn't handle local-only email addresses (when users pass +in just usernames on the RT system in fields that expect +Email Addresses) + +We don't handle the case of +bob, fred@bestpractical.com +because we don't want to fail parsing +bob, "Falcone, Fred" <fred@bestpractical.com> +The next release of Email::Address will have a new method +we can use that removes the bandaid + +=cut + +sub ParseEmailAddress { + my $self = shift; + my $address_string = shift; + + $address_string =~ s/^\s+|\s+$//g; + + my @addresses; + # if it looks like a username / local only email + if ($address_string !~ /@/ && $address_string =~ /^\w+$/) { + my $user = RT::User->new( RT->SystemUser ); + my ($id, $msg) = $user->Load($address_string); + if ($id) { + push @addresses, Email::Address->new($user->Name,$user->EmailAddress); + } else { + $RT::Logger->error("Unable to parse an email address from $address_string: $msg"); + } + } else { + @addresses = Email::Address->parse($address_string); + } + + $self->CleanupAddresses(@addresses); + + return @addresses; + +} + +=head2 CleanupAddresses ARRAY + +Massages an array of L<Email::Address> objects to make their email addresses +more palatable. + +Currently this strips off surrounding single quotes around C<< ->address >> and +B<< modifies the L<Email::Address> objects in-place >>. + +Returns the list of objects for convienence in C<map>/C<grep> chains. + +=cut + +sub CleanupAddresses { + my $self = shift; + + for my $addr (@_) { + next unless defined $addr; + # Outlook sometimes sends addresses surrounded by single quotes; + # clean them all up + if ((my $email = $addr->address) =~ s/^'(.+)'$/$1/) { + $addr->address($email); + } + } + return @_; +} + +=head2 RescueOutlook + +Outlook 2007/2010 have a bug when you write an email with the html format. +it will send a 'multipart/alternative' with both 'text/plain' and 'text/html' +in it. it's cool to have a 'text/plain' part, but the problem is the part is +not so right: all the "\n" in your main message will become "\n\n" :/ + +this method will fix this bug, i.e. replaces "\n\n" to "\n". +return 1 if it does find the problem in the entity and get it fixed. + +=cut + + +sub RescueOutlook { + my $self = shift; + my $mime = $self->Entity(); + return unless $mime && $self->LooksLikeMSEmail($mime); + + my $text_part; + if ( $mime->head->get('Content-Type') =~ m{multipart/mixed} ) { + my $first = $mime->parts(0); + if ( $first && $first->head->get('Content-Type') =~ m{multipart/alternative} ) + { + my $inner_first = $first->parts(0); + if ( $inner_first && $inner_first->head->get('Content-Type') =~ m{text/plain} ) + { + $text_part = $inner_first; + } + } + } + elsif ( $mime->head->get('Content-Type') =~ m{multipart/alternative} ) { + my $first = $mime->parts(0); + if ( $first && $first->head->get('Content-Type') =~ m{text/plain} ) { + $text_part = $first; + } + } + + # Add base64 since we've seen examples of double newlines with + # this type too. Need an example of a multi-part base64 to + # handle that permutation if it exists. + elsif ( $mime->head->get('Content-Transfer-Encoding') =~ m{base64} ) { + $text_part = $mime; # Assuming single part, already decoded. + } + + if ($text_part) { + + # use the unencoded string + my $content = $text_part->bodyhandle->as_string; + if ( $content =~ s/\n\n/\n/g ) { + + # Outlook puts a space on extra newlines, remove it + $content =~ s/\ +$//mg; + + # only write only if we did change the content + if ( my $io = $text_part->open("w") ) { + $io->print($content); + $io->close; + $RT::Logger->debug( + "Removed extra newlines from MS Outlook message."); + return 1; + } + else { + $RT::Logger->error("Can't write to body to fix newlines"); + } + } + } + + return; +} + +=head1 LooksLikeMSEmail + +Try to determine if the current email may have +come from MS Outlook or gone through Exchange, and therefore +may have extra newlines added. + +=cut + +sub LooksLikeMSEmail { + my $self = shift; + my $mime = shift; + + my $mailer = $mime->head->get('X-Mailer'); + + # 12.0 is outlook 2007, 14.0 is 2010 + return 1 if ( $mailer && $mailer =~ /Microsoft(?:.*?)Outlook 1[2-4]\./ ); + + if ( RT->Config->Get('CheckMoreMSMailHeaders') ) { + + # Check for additional headers that might + # indicate this came from Outlook or through Exchange. + # A sample we received had the headers X-MS-Has-Attach: and + # X-MS-Tnef-Correlator: and both had no value. + + my @tags = $mime->head->tags(); + return 1 if grep { /^X-MS-/ } @tags; + } + + return 0; # Doesn't look like MS email. +} + +sub DESTROY { + my $self = shift; + File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1) + if $self->{'AttachmentDirs'}; +} + + + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Generated.pm b/rt/lib/RT/Generated.pm index f4fb88d8f..2f46d4886 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.21'; +our $VERSION = '4.0.22'; diff --git a/rt/lib/RT/I18N.pm b/rt/lib/RT/I18N.pm index bc267e438..11cd5f120 100644 --- a/rt/lib/RT/I18N.pm +++ b/rt/lib/RT/I18N.pm @@ -62,7 +62,6 @@ use Locale::Maketext 1.04; use Locale::Maketext::Lexicon 0.25; use base 'Locale::Maketext::Fuzzy'; -use Encode; use MIME::Entity; use MIME::Head; use File::Glob; @@ -231,7 +230,7 @@ sub SetMIMEEntityToEncoding { ); # If this is a textual entity, we'd need to preserve its original encoding - $head->replace( "X-RT-Original-Encoding" => $charset ) + $head->replace( "X-RT-Original-Encoding" => Encode::encode( "UTF-8", $charset ) ) if $head->mime_attr('content-type.charset') or IsTextualContentType($head->mime_type); return unless IsTextualContentType($head->mime_type); @@ -240,13 +239,12 @@ sub SetMIMEEntityToEncoding { if ( $body && ($enc ne $charset || $enc =~ /^utf-?8(?:-strict)?$/i) ) { my $string = $body->as_string or return; + RT::Util::assert_bytes($string); $RT::Logger->debug( "Converting '$charset' to '$enc' for " . $head->mime_type . " - " - . ( $head->get('subject') || 'Subjectless message' ) ); + . ( Encode::decode("UTF-8",$head->get('subject')) || 'Subjectless message' ) ); - # NOTE:: see the comments at the end of the sub. - Encode::_utf8_off($string); Encode::from_to( $string, $charset => $enc ); my $new_body = MIME::Body::InCore->new($string); @@ -259,30 +257,11 @@ sub SetMIMEEntityToEncoding { } } -# NOTES: Why Encode::_utf8_off before Encode::from_to -# -# All the strings in RT are utf-8 now. Quotes from Encode POD: -# -# [$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK]) -# ... The data in $octets must be encoded as octets and not as -# characters in Perl's internal format. ... -# -# Not turning off the UTF-8 flag in the string will prevent the string -# from conversion. - - - =head2 DecodeMIMEWordsToUTF8 $raw An utility method which mimics MIME::Words::decode_mimewords, but only -limited functionality. This function returns an utf-8 string. - -It returns the decoded string, or the original string if it's not -encoded. Since the subroutine converts specified string into utf-8 -charset, it should not alter a subject written in English. - -Why not use MIME::Words directly? Because it fails in RT when I -tried. Maybe it's ok now. +limited functionality. Despite its name, this function returns the +bytes of the string, in UTF-8. =cut @@ -563,13 +542,13 @@ sub SetMIMEHeadToEncoding { return if $charset eq $enc and $preserve_words; + RT::Util::assert_bytes( $head->as_string ); foreach my $tag ( $head->tags ) { next unless $tag; # seen in wild: headers with no name my @values = $head->get_all($tag); $head->delete($tag); foreach my $value (@values) { if ( $charset ne $enc || $enc =~ /^utf-?8(?:-strict)?$/i ) { - Encode::_utf8_off($value); Encode::from_to( $value, $charset => $enc ); } $value = DecodeMIMEWordsToEncoding( $value, $enc, $tag ) diff --git a/rt/lib/RT/I18N/de.pm b/rt/lib/RT/I18N/de.pm new file mode 100644 index 000000000..3a40a7f9e --- /dev/null +++ b/rt/lib/RT/I18N/de.pm @@ -0,0 +1,61 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +package RT::I18N::de; +use base 'RT::I18N'; + +sub init { + $_[0]->{numf_comma} = 1; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/I18N/fr.pm b/rt/lib/RT/I18N/fr.pm new file mode 100644 index 000000000..904b84199 --- /dev/null +++ b/rt/lib/RT/I18N/fr.pm @@ -0,0 +1,68 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +package RT::I18N::fr; +use base 'RT::I18N'; + +use strict; +use warnings; + +sub numf { + my ($handle, $num) = @_[0,1]; + my $fr_num = $handle->SUPER::numf($num); + # French prefer to print 1000 as 1(nbsp)000 rather than 1,000 + $fr_num =~ tr<.,><,\x{A0}>; + return $fr_num; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index 74120ba07..a4826ad36 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -114,7 +114,7 @@ sub CheckForLoops { my $head = shift; # If this instance of RT sent it our, we don't want to take it in - my $RTLoop = $head->get("X-RT-Loop-Prevention") || ""; + my $RTLoop = Encode::decode( "UTF-8", $head->get("X-RT-Loop-Prevention") || "" ); chomp ($RTLoop); # remove that newline if ( $RTLoop eq RT->Config->Get('rtname') ) { return 1; @@ -253,22 +253,27 @@ sub MailError { # the colons are necessary to make ->build include non-standard headers my %entity_args = ( Type => "multipart/mixed", - From => $args{'From'}, - Bcc => $args{'Bcc'}, - To => $args{'To'}, - Subject => $args{'Subject'}, - 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'), + From => Encode::encode( "UTF-8", $args{'From'} ), + Bcc => Encode::encode( "UTF-8", $args{'Bcc'} ), + To => Encode::encode( "UTF-8", $args{'To'} ), + Subject => EncodeToMIME( String => $args{'Subject'} ), + 'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", RT->Config->Get('rtname') ), ); # only set precedence if the sysadmin wants us to if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) { - $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence'); + $entity_args{'Precedence:'} = + Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') ); } my $entity = MIME::Entity->build(%entity_args); SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} ); - $entity->attach( Data => $args{'Explanation'} . "\n" ); + $entity->attach( + Type => "text/plain", + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ), + ); if ( $args{'MIMEObj'} ) { $args{'MIMEObj'}->sync_headers; @@ -276,7 +281,7 @@ sub MailError { } if ( $args{'Attach'} ) { - $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' ); + $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' ); } @@ -374,7 +379,7 @@ sub SendEmail { return 0; } - my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); chomp $msgid; # If we don't have any recipients to send to, don't send a message; @@ -411,7 +416,7 @@ sub SendEmail { require RT::Date; my $date = RT::Date->new( RT->SystemUser ); $date->SetToNow; - $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) ); + $args{'Entity'}->head->set( 'Date', Encode::encode( "UTF-8", $date->RFC2822( Timezone => 'server' ) ) ); } my $mail_command = RT->Config->Get('MailCommand'); @@ -514,12 +519,13 @@ sub SendEmail { # duplicate head as we want drop Bcc field my $head = $args{'Entity'}->head->dup; - my @recipients = map $_->address, map - Email::Address->parse($head->get($_)), qw(To Cc Bcc); + my @recipients = map $_->address, map + Email::Address->parse(Encode::decode("UTF-8", $head->get($_))), + qw(To Cc Bcc); $head->delete('Bcc'); my $sender = RT->Config->Get('SMTPFrom') - || $args{'Entity'}->head->get('From'); + || Encode::decode( "UTF-8", $args{'Entity'}->head->get('From') ); chomp $sender; my $status = $smtp->mail( $sender ) @@ -624,10 +630,10 @@ sub SendEmailUsingTemplate { return -1; } - $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) ) + $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) ) foreach grep defined $args{$_}, qw(To Cc Bcc From); - $mail->head->set( $_ => $args{ExtraHeaders}{$_} ) + $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) ) foreach keys %{ $args{ExtraHeaders} }; SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} ); @@ -760,8 +766,9 @@ sub SendForward { . $txn->id ." of a ticket #". $txn->ObjectId; } $mail = MIME::Entity->build( - Type => 'text/plain', - Data => $description, + Type => 'text/plain', + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $description ), ); } @@ -844,7 +851,7 @@ sub SignEncrypt { ); return 1 unless $args{'Sign'} || $args{'Encrypt'}; - my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); chomp $msgid; $RT::Logger->debug("$msgid Signing message") if $args{'Sign'}; @@ -980,9 +987,6 @@ sub EncodeToMIME { $value =~ s/\s+$//; - # we need perl string to split thing char by char - Encode::_utf8_on($value) unless Encode::is_utf8($value); - my ( $tmp, @chunks ) = ( '', () ); while ( length $value ) { my $char = substr( $value, 0, 1, '' ); @@ -1087,7 +1091,8 @@ sub ParseCcAddressesFromHead { && !IgnoreCcAddress( $_ ) } map lc $user->CanonicalizeEmailAddress( $_->address ), - map RT::EmailParser->CleanupAddresses( Email::Address->parse( $args{'Head'}->get( $_ ) ) ), + map RT::EmailParser->CleanupAddresses( Email::Address->parse( + Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ), qw(To Cc); } @@ -1125,7 +1130,7 @@ sub ParseSenderAddressFromHead { #Figure out who's sending this message. foreach my $header ( @sender_headers ) { - my $addr_line = $head->get($header) || next; + my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next; my ($addr, $name) = ParseAddressFromHeader( $addr_line ); # only return if the address is not empty return ($addr, $name, @errors) if $addr; @@ -1153,7 +1158,7 @@ sub ParseErrorsToAddressFromHead { foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) { # If there's a header of that name - my $headerobj = $head->get($header); + my $headerobj = Encode::decode( "UTF-8", $head->get($header) ); if ($headerobj) { my ( $addr, $name ) = ParseAddressFromHeader($headerobj); @@ -1198,9 +1203,9 @@ sub DeleteRecipientsFromHead { my %skip = map { lc $_ => 1 } @_; foreach my $field ( qw(To Cc Bcc) ) { - $head->set( $field => + $head->set( $field => Encode::encode( "UTF-8", join ', ', map $_->format, grep !$skip{ lc $_->address }, - Email::Address->parse( $head->get( $field ) ) + Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) ) ); } } @@ -1233,7 +1238,7 @@ sub SetInReplyTo { my $get_header = sub { my @res; if ( $args{'InReplyTo'}->isa('MIME::Entity') ) { - @res = $args{'InReplyTo'}->head->get( shift ); + @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift ); } else { @res = $args{'InReplyTo'}->GetHeader( shift ) || ''; } @@ -1256,14 +1261,14 @@ sub SetInReplyTo { if @references > 10; my $mail = $args{'Message'}; - $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; - $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) ); + $mail->head->set( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; + $mail->head->set( 'References' => Encode::encode( "UTF-8", join ' ', @references) ); } sub ExtractTicketId { my $entity = shift; - my $subject = $entity->head->get('Subject') || ''; + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' ); chomp $subject; return ParseTicketId( $subject ); } @@ -1468,14 +1473,14 @@ sub Gateway { my $head = $Message->head; my $ErrorsTo = ParseErrorsToAddressFromHead( $head ); my $Sender = (ParseSenderAddressFromHead( $head ))[0]; - my $From = $head->get("From"); + my $From = Encode::decode( "UTF-8", $head->get("From") ); chomp $From if defined $From; - my $MessageId = $head->get('Message-ID') + my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') ) || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>'; #Pull apart the subject line - my $Subject = $head->get('Subject') || ''; + my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || ''); chomp $Subject; # Lets check for mail loops of various sorts. @@ -1498,7 +1503,7 @@ sub Gateway { $args{'ticket'} ||= ExtractTicketId( $Message ); # ExtractTicketId may have been overridden, and edited the Subject - my $NewSubject = $Message->head->get('Subject'); + my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') ); chomp $NewSubject; $SystemTicket = RT::Ticket->new( RT->SystemUser ); @@ -1746,7 +1751,7 @@ sub _RunUnsafeAction { @_ ); - my $From = $args{Message}->head->get("From"); + my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") ); if ( $args{'Action'} =~ /^take$/i ) { my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id ); @@ -1902,7 +1907,7 @@ sub _HandleMachineGeneratedMail { # to the scrip. We might want to notify nobody. Or just # the RT Owner. Or maybe all Privileged watchers. my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); - $head->replace( 'RT-Squelch-Replies-To', $Sender ); + $head->replace( 'RT-Squelch-Replies-To', Encode::encode("UTF-8", $Sender ) ); $head->replace( 'RT-DetectedAutoGenerated', 'true' ); } return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop ); diff --git a/rt/lib/RT/Interface/Email.pm.orig b/rt/lib/RT/Interface/Email.pm.orig new file mode 100755 index 000000000..74120ba07 --- /dev/null +++ b/rt/lib/RT/Interface/Email.pm.orig @@ -0,0 +1,1944 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +package RT::Interface::Email; + +use strict; +use warnings; + +use Email::Address; +use MIME::Entity; +use RT::EmailParser; +use File::Temp; +use UNIVERSAL::require; +use Mail::Mailer (); +use Text::ParseWords qw/shellwords/; + +BEGIN { + use base 'Exporter'; + use vars qw ( @EXPORT_OK); + + # set the version for version checking + our $VERSION = 2.0; + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw( + &CreateUser + &GetMessageContent + &CheckForLoops + &CheckForSuspiciousSender + &CheckForAutoGenerated + &CheckForBounce + &MailError + &ParseCcAddressesFromHead + &ParseSenderAddressFromHead + &ParseErrorsToAddressFromHead + &ParseAddressFromHeader + &Gateway); + +} + +=head1 NAME + + RT::Interface::Email - helper functions for parsing email sent to RT + +=head1 SYNOPSIS + + use lib "!!RT_LIB_PATH!!"; + use lib "!!RT_ETC_PATH!!"; + + use RT::Interface::Email qw(Gateway CreateUser); + +=head1 DESCRIPTION + + + + +=head1 METHODS + +=head2 CheckForLoops HEAD + +Takes a HEAD object of L<MIME::Head> class and returns true if the +message's been sent by this RT instance. Uses "X-RT-Loop-Prevention" +field of the head for test. + +=cut + +sub CheckForLoops { + my $head = shift; + + # If this instance of RT sent it our, we don't want to take it in + my $RTLoop = $head->get("X-RT-Loop-Prevention") || ""; + chomp ($RTLoop); # remove that newline + if ( $RTLoop eq RT->Config->Get('rtname') ) { + return 1; + } + + # TODO: We might not trap the case where RT instance A sends a mail + # to RT instance B which sends a mail to ... + return undef; +} + +=head2 CheckForSuspiciousSender HEAD + +Takes a HEAD object of L<MIME::Head> class and returns true if sender +is suspicious. Suspicious means mailer daemon. + +See also L</ParseSenderAddressFromHead>. + +=cut + +sub CheckForSuspiciousSender { + my $head = shift; + + #if it's from a postmaster or mailer daemon, it's likely a bounce. + + #TODO: better algorithms needed here - there is no standards for + #bounces, so it's very difficult to separate them from anything + #else. At the other hand, the Return-To address is only ment to be + #used as an error channel, we might want to put up a separate + #Return-To address which is treated differently. + + #TODO: search through the whole email and find the right Ticket ID. + + my ( $From, $junk ) = ParseSenderAddressFromHead($head); + + # If unparseable (non-ASCII), $From can come back undef + return undef if not defined $From; + + if ( ( $From =~ /^mailer-daemon\@/i ) + or ( $From =~ /^postmaster\@/i ) + or ( $From eq "" )) + { + return (1); + + } + + return undef; +} + +=head2 CheckForAutoGenerated HEAD + +Takes a HEAD object of L<MIME::Head> class and returns true if message +is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated' +fields of the head in tests. + +=cut + +sub CheckForAutoGenerated { + my $head = shift; + + my $Precedence = $head->get("Precedence") || ""; + if ( $Precedence =~ /^(bulk|junk)/i ) { + return (1); + } + + # Per RFC3834, any Auto-Submitted header which is not "no" means + # it is auto-generated. + my $AutoSubmitted = $head->get("Auto-Submitted") || ""; + if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) { + return (1); + } + + # First Class mailer uses this as a clue. + my $FCJunk = $head->get("X-FC-Machinegenerated") || ""; + if ( $FCJunk =~ /^true/i ) { + return (1); + } + + return (0); +} + + +sub CheckForBounce { + my $head = shift; + + my $ReturnPath = $head->get("Return-path") || ""; + return ( $ReturnPath =~ /<>/ ); +} + + +=head2 MailError PARAM HASH + +Sends an error message. Takes a param hash: + +=over 4 + +=item From - sender's address, by default is 'CorrespondAddress'; + +=item To - recipient, by default is 'OwnerEmail'; + +=item Bcc - optional Bcc recipients; + +=item Subject - subject of the message, default is 'There has been an error'; + +=item Explanation - main content of the error, default value is 'Unexplained error'; + +=item MIMEObj - optional MIME entity that's attached to the error mail, as well we +add 'In-Reply-To' field to the error that points to this message. + +=item Attach - optional text that attached to the error as 'message/rfc822' part. + +=item LogLevel - log level under which we should write the subject and +explanation message into the log, by default we log it as critical. + +=back + +=cut + +sub MailError { + my %args = ( + To => RT->Config->Get('OwnerEmail'), + Bcc => undef, + From => RT->Config->Get('CorrespondAddress'), + Subject => 'There has been an error', + Explanation => 'Unexplained error', + MIMEObj => undef, + Attach => undef, + LogLevel => 'crit', + @_ + ); + + $RT::Logger->log( + level => $args{'LogLevel'}, + message => "$args{Subject}: $args{'Explanation'}", + ) if $args{'LogLevel'}; + + # the colons are necessary to make ->build include non-standard headers + my %entity_args = ( + Type => "multipart/mixed", + From => $args{'From'}, + Bcc => $args{'Bcc'}, + To => $args{'To'}, + Subject => $args{'Subject'}, + 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'), + ); + + # only set precedence if the sysadmin wants us to + if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) { + $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence'); + } + + my $entity = MIME::Entity->build(%entity_args); + SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} ); + + $entity->attach( Data => $args{'Explanation'} . "\n" ); + + if ( $args{'MIMEObj'} ) { + $args{'MIMEObj'}->sync_headers; + $entity->add_part( $args{'MIMEObj'} ); + } + + if ( $args{'Attach'} ) { + $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' ); + + } + + SendEmail( Entity => $entity, Bounce => 1 ); +} + + +=head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ] + +Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using +RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a +true value, the message will be marked as an autogenerated error, if +possible. Sets Date field of the head to now if it's not set. + +If the C<X-RT-Squelch> header is set to any true value, the mail will +not be sent. One use is to let extensions easily cancel outgoing mail. + +Ticket and Transaction arguments are optional. If Transaction is +specified and Ticket is not then ticket of the transaction is +used, but only if the transaction belongs to a ticket. + +Returns 1 on success, 0 on error or -1 if message has no recipients +and hasn't been sent. + +=head3 Signing and Encrypting + +This function as well signs and/or encrypts the message according to +headers of a transaction's attachment or properties of a ticket's queue. +To get full access to the configuration Ticket and/or Transaction +arguments must be provided, but you can force behaviour using Sign +and/or Encrypt arguments. + +The following precedence of arguments are used to figure out if +the message should be encrypted and/or signed: + +* if Sign or Encrypt argument is defined then its value is used + +* else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt +header field then it's value is used + +* else properties of a queue of the Ticket are 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, + Bounce => 0, + Ticket => undef, + Transaction => undef, + @_, + ); + + my $TicketObj = $args{'Ticket'}; + my $TransactionObj = $args{'Transaction'}; + + foreach my $arg( qw(Entity Bounce) ) { + next unless defined $args{ lc $arg }; + + $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead"); + $args{ $arg } = delete $args{ lc $arg }; + } + + unless ( $args{'Entity'} ) { + $RT::Logger->crit( "Could not send mail without 'Entity' object" ); + return 0; + } + + my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + chomp $msgid; + + # If we don't have any recipients to send to, don't send a message; + unless ( $args{'Entity'}->head->get('To') + || $args{'Entity'}->head->get('Cc') + || $args{'Entity'}->head->get('Bcc') ) + { + $RT::Logger->info( $msgid . " No recipients found. Not sending." ); + return -1; + } + + if ($args{'Entity'}->head->get('X-RT-Squelch')) { + $RT::Logger->info( $msgid . " Squelch header found. Not sending." ); + return -1; + } + + if ( $TransactionObj && !$TicketObj + && $TransactionObj->ObjectType eq 'RT::Ticket' ) + { + $TicketObj = $TransactionObj->Object; + } + + if ( RT->Config->Get('GnuPG')->{'Enable'} ) { + %args = WillSignEncrypt( + %args, + Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef, + Ticket => $TicketObj, + ); + my $res = SignEncrypt( %args ); + return $res unless $res > 0; + } + + unless ( $args{'Entity'}->head->get('Date') ) { + require RT::Date; + my $date = RT::Date->new( RT->SystemUser ); + $date->SetToNow; + $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) ); + } + + my $mail_command = RT->Config->Get('MailCommand'); + + if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) { + $Mail::Mailer::testfile::config{outfile} = File::Temp->new; + $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}"); + } + + # if it is a sub routine, we just return it; + return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' ); + + if ( $mail_command eq 'sendmailpipe' ) { + my $path = RT->Config->Get('SendmailPath'); + my @args = shellwords(RT->Config->Get('SendmailArguments')); + + # SetOutgoingMailFrom and bounces conflict, since they both want -f + if ( $args{'Bounce'} ) { + push @args, shellwords(RT->Config->Get('SendmailBounceArguments')); + } elsif ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) { + my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef; + my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {}; + + if ($TicketObj) { + my $QueueName = $TicketObj->QueueObj->Name; + my $QueueAddressOverride = $Overrides->{$QueueName}; + + if ($QueueAddressOverride) { + $OutgoingMailAddress = $QueueAddressOverride; + } else { + $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); + } + } + elsif ($Overrides->{'Default'}) { + $OutgoingMailAddress = $Overrides->{'Default'}; + } + + push @args, "-f", $OutgoingMailAddress + if $OutgoingMailAddress; + } + + # VERP + if ( $TransactionObj and + my $prefix = RT->Config->Get('VERPPrefix') and + my $domain = RT->Config->Get('VERPDomain') ) + { + my $from = $TransactionObj->CreatorObj->EmailAddress; + $from =~ s/@/=/g; + $from =~ s/\s//g; + push @args, "-f", "$prefix$from\@$domain"; + } + + eval { + # don't ignore CHLD signal to get proper exit code + local $SIG{'CHLD'} = 'DEFAULT'; + + # if something wrong with $mail->print we will get PIPE signal, handle it + local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" }; + + require IPC::Open2; + my ($mail, $stdout); + my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args ) + or die "couldn't execute program: $!"; + + $args{'Entity'}->print($mail); + close $mail or die "close pipe failed: $!"; + + waitpid($pid, 0); + if ($?) { + # sendmail exit statuses mostly errors with data not software + # TODO: status parsing: core dump, exit on signal or EX_* + my $msg = "$msgid: `$path @args` exited with code ". ($?>>8); + $msg = ", interrupted by signal ". ($?&127) if $?&127; + $RT::Logger->error( $msg ); + die $msg; + } + }; + if ( $@ ) { + $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ ); + if ( $TicketObj ) { + _RecordSendEmailFailure( $TicketObj ); + } + return 0; + } + } + elsif ( $mail_command eq 'smtp' ) { + require Net::SMTP; + my $smtp = do { local $@; eval { Net::SMTP->new( + Host => RT->Config->Get('SMTPServer'), + Debug => RT->Config->Get('SMTPDebug'), + ) } }; + unless ( $smtp ) { + $RT::Logger->crit( "Could not connect to SMTP server."); + if ($TicketObj) { + _RecordSendEmailFailure( $TicketObj ); + } + return 0; + } + + # duplicate head as we want drop Bcc field + my $head = $args{'Entity'}->head->dup; + my @recipients = map $_->address, map + Email::Address->parse($head->get($_)), qw(To Cc Bcc); + $head->delete('Bcc'); + + my $sender = RT->Config->Get('SMTPFrom') + || $args{'Entity'}->head->get('From'); + chomp $sender; + + my $status = $smtp->mail( $sender ) + && $smtp->recipient( @recipients ); + + if ( $status ) { + $smtp->data; + my $fh = $smtp->tied_fh; + $head->print( $fh ); + print $fh "\n"; + $args{'Entity'}->print_body( $fh ); + $smtp->dataend; + } + $smtp->quit; + + unless ( $status ) { + $RT::Logger->crit( "$msgid: Could not send mail via SMTP." ); + if ( $TicketObj ) { + _RecordSendEmailFailure( $TicketObj ); + } + return 0; + } + } + else { + local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'}); + + my @mailer_args = ($mail_command); + if ( $mail_command eq 'sendmail' ) { + $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath'); + push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments')); + } + else { + push @mailer_args, RT->Config->Get('MailParams'); + } + + unless ( $args{'Entity'}->send( @mailer_args ) ) { + $RT::Logger->crit( "$msgid: Could not send mail." ); + if ( $TicketObj ) { + _RecordSendEmailFailure( $TicketObj ); + } + return 0; + } + } + return 1; +} + +=head2 PrepareEmailUsingTemplate Template => '', Arguments => {} + +Loads a template. Parses it using arguments if it's not empty. +Returns a tuple (L<RT::Template> object, error message). + +Note that even if a template object is returned MIMEObj method +may return undef for empty templates. + +=cut + +sub PrepareEmailUsingTemplate { + my %args = ( + Template => '', + Arguments => {}, + @_ + ); + + my $template = RT::Template->new( RT->SystemUser ); + $template->LoadGlobalTemplate( $args{'Template'} ); + unless ( $template->id ) { + return (undef, "Couldn't load template '". $args{'Template'} ."'"); + } + return $template if $template->IsEmpty; + + my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } ); + return (undef, $msg) unless $status; + + return $template; +} + +=head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => '' + +Sends email using a template, takes name of template, arguments for it and recipients. + +=cut + +sub SendEmailUsingTemplate { + my %args = ( + Template => '', + Arguments => {}, + To => undef, + Cc => undef, + Bcc => undef, + From => RT->Config->Get('CorrespondAddress'), + InReplyTo => undef, + ExtraHeaders => {}, + @_ + ); + + my ($template, $msg) = PrepareEmailUsingTemplate( %args ); + return (0, $msg) unless $template; + + my $mail = $template->MIMEObj; + unless ( $mail ) { + $RT::Logger->info("Message is not sent as template #". $template->id ." is empty"); + return -1; + } + + $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) ) + foreach grep defined $args{$_}, qw(To Cc Bcc From); + + $mail->head->set( $_ => $args{ExtraHeaders}{$_} ) + foreach keys %{ $args{ExtraHeaders} }; + + SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} ); + + return SendEmail( Entity => $mail ); +} + +=head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => '' + +Forwards transaction with all attachments as 'message/rfc822'. + +=cut + +sub ForwardTransaction { + my $txn = shift; + my %args = ( To => '', Cc => '', Bcc => '', @_ ); + + my $entity = $txn->ContentAsMIME; + + my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn ); + if ($ret) { + my $ticket = $txn->TicketObj; + my ( $ret, $msg ) = $ticket->_NewTransaction( + Type => 'Forward Transaction', + Field => $txn->id, + Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc}, + ); + unless ($ret) { + $RT::Logger->error("Failed to create transaction: $msg"); + } + } + return ( $ret, $msg ); +} + +=head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => '' + +Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'. + +=cut + +sub ForwardTicket { + my $ticket = shift; + my %args = ( To => '', Cc => '', Bcc => '', @_ ); + + my $txns = $ticket->Transactions; + $txns->Limit( + FIELD => 'Type', + VALUE => $_, + ) for qw(Create Correspond); + + my $entity = MIME::Entity->build( + Type => 'multipart/mixed', + Description => 'forwarded ticket', + ); + $entity->add_part( $_ ) foreach + map $_->ContentAsMIME, + @{ $txns->ItemsArrayRef }; + + my ( $ret, $msg ) = SendForward( + %args, + Entity => $entity, + Ticket => $ticket, + Template => 'Forward Ticket', + ); + + if ($ret) { + my ( $ret, $msg ) = $ticket->_NewTransaction( + Type => 'Forward Ticket', + Field => $ticket->id, + Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc}, + ); + unless ($ret) { + $RT::Logger->error("Failed to create transaction: $msg"); + } + } + + return ( $ret, $msg ); + +} + +=head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => '' + +Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template. + +=cut + +sub SendForward { + my (%args) = ( + Entity => undef, + Ticket => undef, + Transaction => undef, + Template => 'Forward', + To => '', Cc => '', Bcc => '', + @_ + ); + + my $txn = $args{'Transaction'}; + my $ticket = $args{'Ticket'}; + $ticket ||= $txn->Object if $txn; + + my $entity = $args{'Entity'}; + unless ( $entity ) { + require Carp; + $RT::Logger->error(Carp::longmess("No entity provided")); + return (0, $ticket->loc("Couldn't send email")); + } + + my ($template, $msg) = PrepareEmailUsingTemplate( + Template => $args{'Template'}, + Arguments => { + Ticket => $ticket, + Transaction => $txn, + }, + ); + + my $mail; + if ( $template ) { + $mail = $template->MIMEObj; + } else { + $RT::Logger->warning($msg); + } + unless ( $mail ) { + $RT::Logger->warning("Couldn't generate email using template '$args{Template}'"); + + my $description; + unless ( $args{'Transaction'} ) { + $description = 'This is forward of ticket #'. $ticket->id; + } else { + $description = 'This is forward of transaction #' + . $txn->id ." of a ticket #". $txn->ObjectId; + } + $mail = MIME::Entity->build( + Type => 'text/plain', + Data => $description, + ); + } + + $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) ) + foreach grep defined $args{$_}, qw(To Cc Bcc); + + $mail->make_multipart unless $mail->is_multipart; + $mail->add_part( $entity ); + + my $from; + unless (defined $mail->head->get('Subject')) { + my $subject = ''; + $subject = $txn->Subject if $txn; + $subject ||= $ticket->Subject if $ticket; + + unless ( RT->Config->Get('ForwardFromUser') ) { + # XXX: what if want to forward txn of other object than ticket? + $subject = AddSubjectTag( $subject, $ticket ); + } + + $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) ); + } + + $mail->head->set( + From => EncodeToMIME( + String => GetForwardFrom( Transaction => $txn, Ticket => $ticket ) + ) + ); + + my $status = RT->Config->Get('ForwardFromUser') + # never sign if we forward from User + ? SendEmail( %args, Entity => $mail, Sign => 0 ) + : SendEmail( %args, Entity => $mail ); + return (0, $ticket->loc("Couldn't send email")) unless $status; + return (1, $ticket->loc("Sent email successfully")); +} + +=head2 GetForwardFrom Ticket => undef, Transaction => undef + +Resolve the From field to use in forward mail + +=cut + +sub GetForwardFrom { + my %args = ( Ticket => undef, Transaction => undef, @_ ); + my $txn = $args{Transaction}; + my $ticket = $args{Ticket} || $txn->Object; + + if ( RT->Config->Get('ForwardFromUser') ) { + return ( $txn || $ticket )->CurrentUser->EmailAddress; + } + else { + return $ticket->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); + } +} + +=head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0 + +Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well +handle errors with users' keys. + +If a recipient has no key or has other problems with it, then the +unction sends a error to him using 'Error: public key' template. +Also, notifies RT's owner using template 'Error to RT owner: public key' +to inform that there are problems with users' keys. Then we filter +all bad recipients and retry. + +Returns 1 on success, 0 on error and -1 if all recipients are bad and +had been filtered out. + +=cut + +sub SignEncrypt { + my %args = ( + Entity => undef, + Sign => 0, + Encrypt => 0, + @_ + ); + return 1 unless $args{'Sign'} || $args{'Encrypt'}; + + my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + chomp $msgid; + + $RT::Logger->debug("$msgid Signing message") if $args{'Sign'}; + $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'}; + + require RT::Crypt::GnuPG; + my %res = RT::Crypt::GnuPG::SignEncrypt( %args ); + return 1 unless $res{'exit_code'}; + + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + + my @bad_recipients; + foreach my $line ( @status ) { + # if the passphrase fails, either you have a bad passphrase + # or gpg-agent has died. That should get caught in Create and + # Update, but at least throw an error here + if (($line->{'Operation'}||'') eq 'PassphraseCheck' + && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) { + $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" ); + return 0; + } + next unless ($line->{'Operation'}||'') eq 'RecipientsCheck'; + next if $line->{'Status'} eq 'DONE'; + $RT::Logger->error( $line->{'Message'} ); + push @bad_recipients, $line; + } + return 0 unless @bad_recipients; + + $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0] + foreach @bad_recipients; + + foreach my $recipient ( @bad_recipients ) { + my $status = SendEmailUsingTemplate( + To => $recipient->{'AddressObj'}->address, + Template => 'Error: public key', + Arguments => { + %$recipient, + TicketObj => $args{'Ticket'}, + TransactionObj => $args{'Transaction'}, + }, + ); + unless ( $status ) { + $RT::Logger->error("Couldn't send 'Error: public key'"); + } + } + + my $status = SendEmailUsingTemplate( + To => RT->Config->Get('OwnerEmail'), + Template => 'Error to RT owner: public key', + Arguments => { + BadRecipients => \@bad_recipients, + TicketObj => $args{'Ticket'}, + TransactionObj => $args{'Transaction'}, + }, + ); + unless ( $status ) { + $RT::Logger->error("Couldn't send 'Error to RT owner: public key'"); + } + + DeleteRecipientsFromHead( + $args{'Entity'}->head, + map $_->{'AddressObj'}->address, @bad_recipients + ); + + unless ( $args{'Entity'}->head->get('To') + || $args{'Entity'}->head->get('Cc') + || $args{'Entity'}->head->get('Bcc') ) + { + $RT::Logger->debug("$msgid No recipients that have public key, not sending"); + return -1; + } + + # redo without broken recipients + %res = RT::Crypt::GnuPG::SignEncrypt( %args ); + return 0 if $res{'exit_code'}; + + return 1; +} + +use MIME::Words (); + +=head2 EncodeToMIME + +Takes a hash with a String and a Charset. Returns the string encoded +according to RFC2047, using B (base64 based) encoding. + +String must be a perl string, octets are returned. + +If Charset is not provided then $EmailOutputEncoding config option +is used, or "latin-1" if that is not set. + +=cut + +sub EncodeToMIME { + my %args = ( + String => undef, + Charset => undef, + @_ + ); + my $value = $args{'String'}; + return $value unless $value; # 0 is perfect ascii + my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding'); + my $encoding = 'B'; + + # using RFC2047 notation, sec 2. + # encoded-word = "=?" charset "?" encoding "?" encoded-text "?=" + + # An 'encoded-word' may not be more than 75 characters long + # + # MIME encoding increases 4/3*(number of bytes), and always in multiples + # of 4. Thus we have to find the best available value of bytes available + # for each chunk. + # + # First we get the integer max which max*4/3 would fit on space. + # Then we find the greater multiple of 3 lower or equal than $max. + my $max = int( + ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) ) + * 3 + ) / 4 + ); + $max = int( $max / 3 ) * 3; + + chomp $value; + + if ( $max <= 0 ) { + + # gives an error... + $RT::Logger->crit("Can't encode! Charset or encoding too big."); + return ($value); + } + + return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s; + + $value =~ s/\s+$//; + + # we need perl string to split thing char by char + Encode::_utf8_on($value) unless Encode::is_utf8($value); + + my ( $tmp, @chunks ) = ( '', () ); + while ( length $value ) { + my $char = substr( $value, 0, 1, '' ); + my $octets = Encode::encode( $charset, $char ); + if ( length($tmp) + length($octets) > $max ) { + push @chunks, $tmp; + $tmp = ''; + } + $tmp .= $octets; + } + push @chunks, $tmp if length $tmp; + + # encode an join chuncks + $value = join "\n ", + map MIME::Words::encode_mimeword( $_, $encoding, $charset ), + @chunks; + return ($value); +} + +sub CreateUser { + my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_; + + my $NewUser = RT::User->new( RT->SystemUser ); + + my ( $Val, $Message ) = $NewUser->Create( + Name => ( $Username || $Address ), + EmailAddress => $Address, + RealName => $Name, + Password => undef, + Privileged => 0, + Comments => 'Autocreated on ticket submission', + ); + + unless ($Val) { + + # Deal with the race condition of two account creations at once + if ($Username) { + $NewUser->LoadByName($Username); + } + + unless ( $NewUser->Id ) { + $NewUser->LoadByEmail($Address); + } + + unless ( $NewUser->Id ) { + MailError( + To => $ErrorsTo, + Subject => "User could not be created", + Explanation => + "User creation failed in mailgateway: $Message", + MIMEObj => $entity, + LogLevel => 'crit', + ); + } + } + + #Load the new user object + my $CurrentUser = RT::CurrentUser->new; + $CurrentUser->LoadByEmail( $Address ); + + unless ( $CurrentUser->id ) { + $RT::Logger->warning( + "Couldn't load user '$Address'." . "giving up" ); + MailError( + To => $ErrorsTo, + Subject => "User could not be loaded", + Explanation => + "User '$Address' could not be loaded in the mail gateway", + MIMEObj => $entity, + LogLevel => 'crit' + ); + } + + return $CurrentUser; +} + + + +=head2 ParseCcAddressesFromHead HASH + +Takes a hash containing QueueObj, Head and CurrentUser objects. +Returns a list of all email addresses in the To and Cc +headers b<except> the current Queue's email addresses, the CurrentUser's +email address and anything that the configuration sub RT::IsRTAddress matches. + +=cut + +sub ParseCcAddressesFromHead { + my %args = ( + Head => undef, + QueueObj => undef, + CurrentUser => undef, + @_ + ); + + my $current_address = lc $args{'CurrentUser'}->EmailAddress; + my $user = $args{'CurrentUser'}->UserObj; + + return + grep { $_ ne $current_address + && !RT::EmailParser->IsRTAddress( $_ ) + && !IgnoreCcAddress( $_ ) + } + map lc $user->CanonicalizeEmailAddress( $_->address ), + map RT::EmailParser->CleanupAddresses( Email::Address->parse( $args{'Head'}->get( $_ ) ) ), + qw(To Cc); +} + +=head2 IgnoreCcAddress ADDRESS + +Returns true if ADDRESS matches the $IgnoreCcRegexp config variable. + +=cut + +sub IgnoreCcAddress { + my $address = shift; + if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) { + return 1 if $address =~ /$address_re/i; + } + return undef; +} + +=head2 ParseSenderAddressFromHead HEAD + +Takes a MIME::Header object. Returns (user@host, friendly name, errors) +where the first two values are the From (evaluated in order of +Reply-To:, From:, Sender). + +A list of error messages may be returned even when a Sender value is +found, since it could be a parse error for another (checked earlier) +sender field. In this case, the errors aren't fatal, but may be useful +to investigate the parse failure. + +=cut + +sub ParseSenderAddressFromHead { + my $head = shift; + my @sender_headers = ('Reply-To', 'From', 'Sender'); + my @errors; # Accumulate any errors + + #Figure out who's sending this message. + foreach my $header ( @sender_headers ) { + my $addr_line = $head->get($header) || next; + my ($addr, $name) = ParseAddressFromHeader( $addr_line ); + # only return if the address is not empty + return ($addr, $name, @errors) if $addr; + + chomp $addr_line; + push @errors, "$header: $addr_line"; + } + + return (undef, undef, @errors); +} + +=head2 ParseErrorsToAddressFromHead HEAD + +Takes a MIME::Header object. Return a single value : user@host +of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:, +From:, Sender) + +=cut + +sub ParseErrorsToAddressFromHead { + my $head = shift; + + #Figure out who's sending this message. + + foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) { + + # If there's a header of that name + my $headerobj = $head->get($header); + if ($headerobj) { + my ( $addr, $name ) = ParseAddressFromHeader($headerobj); + + # If it's got actual useful content... + return ($addr) if ($addr); + } + } +} + + + +=head2 ParseAddressFromHeader ADDRESS + +Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name + +=cut + +sub ParseAddressFromHeader { + my $Addr = shift; + + # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate + $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g; + my @Addresses = RT::EmailParser->ParseEmailAddress($Addr); + + my ($AddrObj) = grep ref $_, @Addresses; + unless ( $AddrObj ) { + return ( undef, undef ); + } + + return ( $AddrObj->address, $AddrObj->phrase ); +} + +=head2 DeleteRecipientsFromHead HEAD RECIPIENTS + +Gets a head object and list of addresses. +Deletes addresses from To, Cc or Bcc fields. + +=cut + +sub DeleteRecipientsFromHead { + my $head = shift; + my %skip = map { lc $_ => 1 } @_; + + foreach my $field ( qw(To Cc Bcc) ) { + $head->set( $field => + join ', ', map $_->format, grep !$skip{ lc $_->address }, + Email::Address->parse( $head->get( $field ) ) + ); + } +} + +sub GenMessageId { + my %args = ( + Ticket => undef, + Scrip => undef, + ScripAction => undef, + @_ + ); + my $org = RT->Config->Get('Organization'); + my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0; + my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0; + my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0; + + return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.' + . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ; +} + +sub SetInReplyTo { + my %args = ( + Message => undef, + InReplyTo => undef, + Ticket => undef, + @_ + ); + return unless $args{'Message'} && $args{'InReplyTo'}; + + my $get_header = sub { + my @res; + if ( $args{'InReplyTo'}->isa('MIME::Entity') ) { + @res = $args{'InReplyTo'}->head->get( shift ); + } else { + @res = $args{'InReplyTo'}->GetHeader( shift ) || ''; + } + return grep length, map { split /\s+/m, $_ } grep defined, @res; + }; + + my @id = $get_header->('Message-ID'); + #XXX: custom header should begin with X- otherwise is violation of the standard + my @rtid = $get_header->('RT-Message-ID'); + my @references = $get_header->('References'); + unless ( @references ) { + @references = $get_header->('In-Reply-To'); + } + push @references, @id, @rtid; + if ( $args{'Ticket'} ) { + my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>'; + push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references; + } + @references = splice @references, 4, -6 + if @references > 10; + + my $mail = $args{'Message'}; + $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; + $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) ); +} + +sub ExtractTicketId { + my $entity = shift; + + my $subject = $entity->head->get('Subject') || ''; + chomp $subject; + return ParseTicketId( $subject ); +} + +sub ParseTicketId { + my $Subject = shift; + + my $rtname = RT->Config->Get('rtname'); + my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i; + + my $id; + if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) { + $id = $1; + } else { + foreach my $tag ( RT->System->SubjectTag ) { + next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i; + $id = $1; + last; + } + } + return undef unless $id; + + $RT::Logger->debug("Found a ticket ID. It's $id"); + return $id; +} + +sub AddSubjectTag { + my $subject = shift; + my $ticket = shift; + unless ( ref $ticket ) { + my $tmp = RT::Ticket->new( RT->SystemUser ); + $tmp->Load( $ticket ); + $ticket = $tmp; + } + my $id = $ticket->id; + my $queue_tag = $ticket->QueueObj->SubjectTag; + + my $tag_re = RT->Config->Get('EmailSubjectTagRegex'); + unless ( $tag_re ) { + my $tag = $queue_tag || RT->Config->Get('rtname'); + $tag_re = qr/\Q$tag\E/; + } elsif ( $queue_tag ) { + $tag_re = qr/$tag_re|\Q$queue_tag\E/; + } + return $subject if $subject =~ /\[$tag_re\s+#$id\]/; + + $subject =~ s/(\r\n|\n|\s)/ /g; + chomp $subject; + return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject"; +} + + +=head2 Gateway ARGSREF + + +Takes parameters: + + action + queue + message + + +This performs all the "guts" of the mail rt-mailgate program, and is +designed to be called from the web interface with a message, user +object, and so on. + +Can also take an optional 'ticket' parameter; this ticket id overrides +any ticket id found in the subject. + +Returns: + + An array of: + + (status code, message, optional ticket object) + + status code is a numeric value. + + for temporary failures, the status code should be -75 + + for permanent failures which are handled by RT, the status code + should be 0 + + for succces, the status code should be 1 + + + +=cut + +sub _LoadPlugins { + my @mail_plugins = @_; + + my @res; + foreach my $plugin (@mail_plugins) { + if ( ref($plugin) eq "CODE" ) { + push @res, $plugin; + } elsif ( !ref $plugin ) { + my $Class = $plugin; + $Class = "RT::Interface::Email::" . $Class + unless $Class =~ /^RT::/; + $Class->require or + do { $RT::Logger->error("Couldn't load $Class: $@"); next }; + + no strict 'refs'; + unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) { + $RT::Logger->crit( "No GetCurrentUser code found in $Class module"); + next; + } + push @res, $Class; + } else { + $RT::Logger->crit( "$plugin - is not class name or code reference"); + } + } + return @res; +} + +sub Gateway { + my $argsref = shift; + my %args = ( + action => 'correspond', + queue => '1', + ticket => undef, + message => undef, + %$argsref + ); + + my $SystemTicket; + my $Right; + + # Validate the action + my ( $status, @actions ) = IsCorrectAction( $args{'action'} ); + unless ($status) { + return ( + -75, + "Invalid 'action' parameter " + . $actions[0] + . " for queue " + . $args{'queue'}, + undef + ); + } + + my $parser = RT::EmailParser->new(); + $parser->SmartParseMIMEEntityFromScalar( + Message => $args{'message'}, + Decode => 0, + Exact => 1, + ); + + my $Message = $parser->Entity(); + unless ($Message) { + MailError( + Subject => "RT Bounce: Unparseable message", + Explanation => "RT couldn't process the message below", + Attach => $args{'message'} + ); + + return ( 0, + "Failed to parse this message. Something is likely badly wrong with the message" + ); + } + + my @mail_plugins = grep $_, RT->Config->Get('MailPlugins'); + push @mail_plugins, "Auth::MailFrom" unless @mail_plugins; + @mail_plugins = _LoadPlugins( @mail_plugins ); + + my %skip_plugin; + foreach my $class( grep !ref, @mail_plugins ) { + # check if we should apply filter before decoding + my $check_cb = do { + no strict 'refs'; + *{ $class . "::ApplyBeforeDecode" }{CODE}; + }; + next unless defined $check_cb; + next unless $check_cb->( + Message => $Message, + RawMessageRef => \$args{'message'}, + ); + + $skip_plugin{ $class }++; + + my $Code = do { + no strict 'refs'; + *{ $class . "::GetCurrentUser" }{CODE}; + }; + my ($status, $msg) = $Code->( + Message => $Message, + RawMessageRef => \$args{'message'}, + ); + next if $status > 0; + + if ( $status == -2 ) { + return (1, $msg, undef); + } elsif ( $status == -1 ) { + return (0, $msg, undef); + } + } + @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins; + $parser->_DecodeBodies; + $parser->RescueOutlook; + $parser->_PostProcessNewEntity; + + my $head = $Message->head; + my $ErrorsTo = ParseErrorsToAddressFromHead( $head ); + my $Sender = (ParseSenderAddressFromHead( $head ))[0]; + my $From = $head->get("From"); + chomp $From if defined $From; + + my $MessageId = $head->get('Message-ID') + || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>'; + + #Pull apart the subject line + my $Subject = $head->get('Subject') || ''; + chomp $Subject; + + # Lets check for mail loops of various sorts. + my ($should_store_machine_generated_message, $IsALoop, $result); + ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) = + _HandleMachineGeneratedMail( + Message => $Message, + ErrorsTo => $ErrorsTo, + Subject => $Subject, + MessageId => $MessageId + ); + + # Do not pass loop messages to MailPlugins, to make sure the loop + # is broken, unless $RT::StoreLoops is set. + if ($IsALoop && !$should_store_machine_generated_message) { + return ( 0, $result, undef ); + } + # }}} + + $args{'ticket'} ||= ExtractTicketId( $Message ); + + # ExtractTicketId may have been overridden, and edited the Subject + my $NewSubject = $Message->head->get('Subject'); + chomp $NewSubject; + + $SystemTicket = RT::Ticket->new( RT->SystemUser ); + $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ; + if ( $SystemTicket->id ) { + $Right = 'ReplyToTicket'; + } else { + $Right = 'CreateTicket'; + } + + #Set up a queue object + my $SystemQueueObj = RT::Queue->new( RT->SystemUser ); + $SystemQueueObj->Load( $args{'queue'} ); + + # We can safely have no queue of we have a known-good ticket + unless ( $SystemTicket->id || $SystemQueueObj->id ) { + return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef ); + } + + my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel( + MailPlugins => \@mail_plugins, + Actions => \@actions, + Message => $Message, + RawMessageRef => \$args{message}, + SystemTicket => $SystemTicket, + SystemQueue => $SystemQueueObj, + ); + + # If authentication fails and no new user was created, get out. + if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) { + + # If the plugins refused to create one, they lose. + unless ( $AuthStat == -1 ) { + _NoAuthorizedUserFound( + Right => $Right, + Message => $Message, + Requestor => $ErrorsTo, + Queue => $args{'queue'} + ); + + } + return ( 0, "Could not load a valid user", undef ); + } + + # If we got a user, but they don't have the right to say things + if ( $AuthStat == 0 ) { + MailError( + To => $ErrorsTo, + Subject => "Permission Denied", + Explanation => + "You do not have permission to communicate with RT", + MIMEObj => $Message + ); + return ( + 0, + ($CurrentUser->EmailAddress || $CurrentUser->Name) + . " ($Sender) tried to submit a message to " + . $args{'Queue'} + . " without permission.", + undef + ); + } + + + unless ($should_store_machine_generated_message) { + return ( 0, $result, undef ); + } + + # if plugin's updated SystemTicket then update arguments + $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id; + + my $Ticket = RT::Ticket->new($CurrentUser); + + if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions ) + { + + my @Cc; + my @Requestors = ( $CurrentUser->id ); + + if (RT->Config->Get('ParseNewMessageForTicketCcs')) { + @Cc = ParseCcAddressesFromHead( + Head => $head, + CurrentUser => $CurrentUser, + QueueObj => $SystemQueueObj + ); + } + + $head->replace('X-RT-Interface' => 'Email'); + + my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( + Queue => $SystemQueueObj->Id, + Subject => $NewSubject, + Requestor => \@Requestors, + Cc => \@Cc, + MIMEObj => $Message + ); + if ( $id == 0 ) { + MailError( + To => $ErrorsTo, + Subject => "Ticket creation failed: $Subject", + Explanation => $ErrStr, + MIMEObj => $Message + ); + return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket ); + } + + # strip comments&corresponds from the actions we don't need + # to record them if we've created the ticket just now + @actions = grep !/^(comment|correspond)$/, @actions; + $args{'ticket'} = $id; + + } elsif ( $args{'ticket'} ) { + + $Ticket->Load( $args{'ticket'} ); + unless ( $Ticket->Id ) { + my $error = "Could not find a ticket with id " . $args{'ticket'}; + MailError( + To => $ErrorsTo, + Subject => "Message not recorded: $Subject", + Explanation => $error, + MIMEObj => $Message + ); + + return ( 0, $error ); + } + $args{'ticket'} = $Ticket->id; + } else { + return ( 1, "Success", $Ticket ); + } + + # }}} + + my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands'); + foreach my $action (@actions) { + + # If the action is comment, add a comment. + if ( $action =~ /^(?:comment|correspond)$/i ) { + my $method = ucfirst lc $action; + my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message ); + unless ($status) { + + #Warn the sender that we couldn't actually submit the comment. + MailError( + To => $ErrorsTo, + Subject => "Message not recorded ($method): $Subject", + Explanation => $msg, + MIMEObj => $Message + ); + return ( 0, "Message From: $From not recorded: $msg", $Ticket ); + } + } elsif ($unsafe_actions) { + my ( $status, $msg ) = _RunUnsafeAction( + Action => $action, + ErrorsTo => $ErrorsTo, + Message => $Message, + Ticket => $Ticket, + CurrentUser => $CurrentUser, + ); + return ($status, $msg, $Ticket) unless $status == 1; + } + } + return ( 1, "Success", $Ticket ); +} + +=head2 GetAuthenticationLevel + + # Authentication Level + # -1 - Get out. this user has been explicitly declined + # 0 - User may not do anything (Not used at the moment) + # 1 - Normal user + # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate + +=cut + +sub GetAuthenticationLevel { + my %args = ( + MailPlugins => [], + Actions => [], + Message => undef, + RawMessageRef => undef, + SystemTicket => undef, + SystemQueue => undef, + @_, + ); + + my ( $CurrentUser, $AuthStat, $error ); + + # Initalize AuthStat so comparisons work correctly + $AuthStat = -9999999; + + # if plugin returns AuthStat -2 we skip action + # NOTE: this is experimental API and it would be changed + my %skip_action = (); + + # Since this needs loading, no matter what + foreach (@{ $args{MailPlugins} }) { + my ($Code, $NewAuthStat); + if ( ref($_) eq "CODE" ) { + $Code = $_; + } else { + no strict 'refs'; + $Code = *{ $_ . "::GetCurrentUser" }{CODE}; + } + + foreach my $action (@{ $args{Actions} }) { + ( $CurrentUser, $NewAuthStat ) = $Code->( + Message => $args{Message}, + RawMessageRef => $args{RawMessageRef}, + CurrentUser => $CurrentUser, + AuthLevel => $AuthStat, + Action => $action, + Ticket => $args{SystemTicket}, + Queue => $args{SystemQueue}, + ); + +# You get the highest level of authentication you were assigned, unless you get the magic -1 +# If a module returns a "-1" then we discard the ticket, so. + $AuthStat = $NewAuthStat + if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 ); + + last if $AuthStat == -1; + $skip_action{$action}++ if $AuthStat == -2; + } + + # strip actions we should skip + @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}} + if $AuthStat == -2; + last unless @{$args{Actions}}; + + last if $AuthStat == -1; + } + + return $AuthStat if !wantarray; + + return ($AuthStat, $CurrentUser, $error); +} + +sub _RunUnsafeAction { + my %args = ( + Action => undef, + ErrorsTo => undef, + Message => undef, + Ticket => undef, + CurrentUser => undef, + @_ + ); + + my $From = $args{Message}->head->get("From"); + + if ( $args{'Action'} =~ /^take$/i ) { + my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id ); + unless ($status) { + MailError( + To => $args{'ErrorsTo'}, + Subject => "Ticket not taken", + Explanation => $msg, + MIMEObj => $args{'Message'} + ); + return ( 0, "Ticket not taken, by email From: $From" ); + } + } elsif ( $args{'Action'} =~ /^resolve$/i ) { + my $new_status = $args{'Ticket'}->FirstInactiveStatus; + if ($new_status) { + my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status); + unless ($status) { + + #Warn the sender that we couldn't actually submit the comment. + MailError( + To => $args{'ErrorsTo'}, + Subject => "Ticket not resolved", + Explanation => $msg, + MIMEObj => $args{'Message'} + ); + return ( 0, "Ticket not resolved, by email From: $From" ); + } + } + } else { + return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} ); + } + return ( 1, "Success" ); +} + +=head2 _NoAuthorizedUserFound + +Emails the RT Owner and the requestor when the auth plugins return "No auth user found" + +=cut + +sub _NoAuthorizedUserFound { + my %args = ( + Right => undef, + Message => undef, + Requestor => undef, + Queue => undef, + @_ + ); + + # Notify the RT Admin of the failure. + MailError( + To => RT->Config->Get('OwnerEmail'), + Subject => "Could not load a valid user", + Explanation => <<EOT, +RT could not load a valid user, and RT's configuration does not allow +for the creation of a new user for this email (@{[$args{Requestor}]}). + +You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the +queue @{[$args{'Queue'}]}. + +EOT + MIMEObj => $args{'Message'}, + LogLevel => 'error' + ); + + # Also notify the requestor that his request has been dropped. + if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) { + MailError( + To => $args{'Requestor'}, + Subject => "Could not load a valid user", + Explanation => <<EOT, +RT could not load a valid user, and RT's configuration does not allow +for the creation of a new user for your email. + +EOT + MIMEObj => $args{'Message'}, + LogLevel => 'error' + ); + } +} + +=head2 _HandleMachineGeneratedMail + +Takes named params: + Message + ErrorsTo + Subject + +Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc. +Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message", +"This message appears to be a loop (boolean)" ); + +=cut + +sub _HandleMachineGeneratedMail { + my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ ); + my $head = $args{'Message'}->head; + my $ErrorsTo = $args{'ErrorsTo'}; + + my $IsBounce = CheckForBounce($head); + + my $IsAutoGenerated = CheckForAutoGenerated($head); + + my $IsSuspiciousSender = CheckForSuspiciousSender($head); + + my $IsALoop = CheckForLoops($head); + + my $SquelchReplies = 0; + + my $owner_mail = RT->Config->Get('OwnerEmail'); + + #If the message is autogenerated, we need to know, so we can not + # send mail to the sender + if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) { + $SquelchReplies = 1; + $ErrorsTo = $owner_mail; + } + + # Warn someone if it's a loop, before we drop it on the ground + if ($IsALoop) { + $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself."); + + #Should we mail it to RTOwner? + if ( RT->Config->Get('LoopsToRTOwner') ) { + MailError( + To => $owner_mail, + Subject => "RT Bounce: ".$args{'Subject'}, + Explanation => "RT thinks this message may be a bounce", + MIMEObj => $args{Message} + ); + } + + #Do we actually want to store it? + return ( 0, $ErrorsTo, "Message Bounced", $IsALoop ) + unless RT->Config->Get('StoreLoops'); + } + + # Squelch replies if necessary + # Don't let the user stuff the RT-Squelch-Replies-To header. + if ( $head->get('RT-Squelch-Replies-To') ) { + $head->replace( + 'RT-Relocated-Squelch-Replies-To', + $head->get('RT-Squelch-Replies-To') + ); + $head->delete('RT-Squelch-Replies-To'); + } + + if ($SquelchReplies) { + + # Squelch replies to the sender, and also leave a clue to + # allow us to squelch ALL outbound messages. This way we + # can punt the logic of "what to do when we get a bounce" + # to the scrip. We might want to notify nobody. Or just + # the RT Owner. Or maybe all Privileged watchers. + my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); + $head->replace( 'RT-Squelch-Replies-To', $Sender ); + $head->replace( 'RT-DetectedAutoGenerated', 'true' ); + } + return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop ); +} + +=head2 IsCorrectAction + +Returns a list of valid actions we've found for this message + +=cut + +sub IsCorrectAction { + my $action = shift; + my @actions = grep $_, split /-/, $action; + return ( 0, '(no value)' ) unless @actions; + foreach ( @actions ) { + return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/; + } + return ( 1, @actions ); +} + +sub _RecordSendEmailFailure { + my $ticket = shift; + if ($ticket) { + $ticket->_RecordNote( + NoteType => 'SystemError', + Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.", + ); + return 1; + } + else { + $RT::Logger->error( "Can't record send email failure as ticket is missing" ); + return; + } +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm index 5137707e5..898a8d9b7 100755 --- a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm +++ b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm @@ -118,7 +118,7 @@ sub GetCurrentUser { foreach my $part ( $args{'Message'}->parts_DFS ) { my $decrypted; - my $status = $part->head->get( 'X-RT-GnuPG-Status' ); + my $status = Encode::decode( "UTF-8", $part->head->get( 'X-RT-GnuPG-Status' ) ); if ( $status ) { for ( RT::Crypt::GnuPG::ParseStatus( $status ) ) { if ( $_->{Operation} eq 'Decrypt' && $_->{Status} eq 'DONE' ) { @@ -126,7 +126,7 @@ sub GetCurrentUser { } if ( $_->{Operation} eq 'Verify' && $_->{Status} eq 'DONE' ) { $part->head->replace( - 'X-RT-Incoming-Signature' => $_->{UserString} + 'X-RT-Incoming-Signature' => Encode::encode( "UTF-8", $_->{UserString} ) ); } } diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 59d315431..35b0cffa1 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -68,7 +68,6 @@ use URI qw(); use RT::Interface::Web::Menu; use RT::Interface::Web::Session; use Digest::MD5 (); -use Encode qw(); use List::MoreUtils qw(); use JSON qw(); @@ -1127,21 +1126,25 @@ sub StripContent { sub DecodeARGS { my $ARGS = shift; + # Later in the code we use + # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS ); + # instead of $m->call_next to avoid problems with UTF8 keys in + # arguments. Specifically, the call_next method pass through + # original arguments, which are still the encoded bytes, not + # characters. "{ base_comp => $m->request_comp }" is copied from + # mason's source to get the same results as we get from call_next + # method; this feature is not documented. %{$ARGS} = map { # if they've passed multiple values, they'll be an array. if they've # passed just one, a scalar whatever they are, mark them as utf8 my $type = ref($_); ( !$type ) - ? Encode::is_utf8($_) - ? $_ - : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) + ? Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) : ( $type eq 'ARRAY' ) - ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) } - @$_ ] + ? [ map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } @$_ ] : ( $type eq 'HASH' ) - ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) } - %$_ } + ? { map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } %$_ } : $_ } %$ARGS; } @@ -1149,17 +1152,6 @@ sub DecodeARGS { sub PreprocessTimeUpdates { my $ARGS = shift; - # Later in the code we use - # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS ); - # instead of $m->call_next to avoid problems with UTF8 keys in arguments. - # The call_next method pass through original arguments and if you have - # an argument with unicode key then in a next component you'll get two - # records in the args hash: one with key without UTF8 flag and another - # with the flag, which may result into errors. "{ base_comp => $m->request_comp }" - # is copied from mason's source to get the same results as we get from - # call_next method, this feature is not documented, so we just leave it - # here to avoid possible side effects. - # This code canonicalizes time inputs in hours into minutes foreach my $field ( keys %$ARGS ) { next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1}; @@ -1494,8 +1486,12 @@ sub StoreRequestToken { if ($ARGS->{Attach}) { my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' ); my $file_path = delete $ARGS->{'Attach'}; + + # This needs to be decoded because the value is a reference; + # hence it was not decoded along with all of the standard + # arguments in DecodeARGS $data->{attach} = { - filename => Encode::decode_utf8("$file_path"), + filename => Encode::decode("UTF-8", "$file_path"), mime => $attachment, }; } @@ -2008,7 +2004,7 @@ sub ProcessUpdateMessage { Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', ); - $Message->head->replace( 'Message-ID' => Encode::encode_utf8( + $Message->head->replace( 'Message-ID' => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} ) ) ); my $old_txn = RT::Transaction->new( $session{'CurrentUser'} ); @@ -2136,7 +2132,10 @@ sub ProcessAttachments { { # attachment? my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' ); - my $file_path = Encode::decode_utf8("$ARGSRef->{'Attach'}"); + # This needs to be decoded because the value is a reference; + # hence it was not decoded along with all of the standard + # arguments in DecodeARGS + my $file_path = Encode::decode("UTF-8", "$ARGSRef->{'Attach'}"); $session{'Attachments'} = { %{ $session{'Attachments'} || {} }, $file_path => $attachment, }; } @@ -2174,9 +2173,9 @@ sub MakeMIMEEntity { ); my $Message = MIME::Entity->build( Type => 'multipart/mixed', - "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ), + "Message-Id" => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId ), "X-RT-Interface" => $args{Interface}, - map { $_ => Encode::encode_utf8( $args{ $_} ) } + map { $_ => Encode::encode( "UTF-8", $args{ $_} ) } grep defined $args{$_}, qw(Subject From Cc) ); @@ -2188,7 +2187,7 @@ sub MakeMIMEEntity { $Message->attach( Type => $args{'Type'} || 'text/plain', Charset => 'UTF-8', - Data => $args{'Body'}, + Data => Encode::encode( "UTF-8", $args{'Body'} ), ); } @@ -2205,16 +2204,16 @@ sub MakeMIMEEntity { my $uploadinfo = $cgi_object->uploadInfo($filehandle); - my $filename = "$filehandle"; + my $filename = Encode::decode("UTF-8","$filehandle"); $filename =~ s{^.*[\\/]}{}; $Message->attach( Type => $uploadinfo->{'Content-Type'}, - Filename => $filename, - Data => \@content, + Filename => Encode::encode("UTF-8",$filename), + Data => \@content, # Bytes, as read directly from the file, above ); if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) { - $Message->head->set( 'Subject' => $filename ); + $Message->head->set( 'Subject' => Encode::encode( "UTF-8", $filename ) ); } # Attachment parts really shouldn't get a Message-ID or "interface" diff --git a/rt/lib/RT/Interface/Web.pm.orig b/rt/lib/RT/Interface/Web.pm.orig new file mode 100644 index 000000000..59d315431 --- /dev/null +++ b/rt/lib/RT/Interface/Web.pm.orig @@ -0,0 +1,3454 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +## Portions Copyright 2000 Tobias Brox <tobix@fsck.com> + +## This is a library of static subs to be used by the Mason web +## interface to RT + +=head1 NAME + +RT::Interface::Web + + +=cut + +use strict; +use warnings; + +package RT::Interface::Web; + +use RT::SavedSearches; +use URI qw(); +use RT::Interface::Web::Menu; +use RT::Interface::Web::Session; +use Digest::MD5 (); +use Encode qw(); +use List::MoreUtils qw(); +use JSON qw(); + +=head2 SquishedCSS $style + +=cut + +my %SQUISHED_CSS; +sub SquishedCSS { + my $style = shift or die "need name"; + return $SQUISHED_CSS{$style} if $SQUISHED_CSS{$style}; + require RT::Squish::CSS; + my $css = RT::Squish::CSS->new( Style => $style ); + $SQUISHED_CSS{ $css->Style } = $css; + return $css; +} + +=head2 SquishedJS + +=cut + +my $SQUISHED_JS; +sub SquishedJS { + return $SQUISHED_JS if $SQUISHED_JS; + + require RT::Squish::JS; + my $js = RT::Squish::JS->new(); + $SQUISHED_JS = $js; + return $js; +} + +=head2 ClearSquished + +Removes the cached CSS and JS entries, forcing them to be regenerated +on next use. + +=cut + +sub ClearSquished { + undef $SQUISHED_JS; + %SQUISHED_CSS = (); +} + +=head2 EscapeUTF8 SCALARREF + +does a css-busting but minimalist escaping of whatever html you're passing in. + +=cut + +sub EscapeUTF8 { + my $ref = shift; + return unless defined $$ref; + + $$ref =~ s/&/&/g; + $$ref =~ s/</</g; + $$ref =~ s/>/>/g; + $$ref =~ s/\(/(/g; + $$ref =~ s/\)/)/g; + $$ref =~ s/"/"/g; + $$ref =~ s/'/'/g; +} + + + +=head2 EscapeURI SCALARREF + +Escapes URI component according to RFC2396 + +=cut + +sub EscapeURI { + my $ref = shift; + return unless defined $$ref; + + use bytes; + $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg; +} + +=head2 EncodeJSON SCALAR + +Encodes the SCALAR to JSON and returns a JSON string. SCALAR may be a simple +value or a reference. + +=cut + +sub EncodeJSON { + JSON::to_json(shift, { utf8 => 1, allow_nonref => 1 }); +} + +sub _encode_surrogates { + my $uni = $_[0] - 0x10000; + return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00); +} + +sub EscapeJS { + my $ref = shift; + return unless defined $$ref; + + $$ref = "'" . join('', + map { + chr($_) =~ /[a-zA-Z0-9]/ ? chr($_) : + $_ <= 255 ? sprintf("\\x%02X", $_) : + $_ <= 65535 ? sprintf("\\u%04X", $_) : + sprintf("\\u%X\\u%X", _encode_surrogates($_)) + } unpack('U*', $$ref)) + . "'"; +} + +=head2 WebCanonicalizeInfo(); + +Different web servers set different environmental varibles. This +function must return something suitable for REMOTE_USER. By default, +just downcase $ENV{'REMOTE_USER'} + +=cut + +sub WebCanonicalizeInfo { + return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'}; +} + + + +=head2 WebExternalAutoInfo($user); + +Returns a hash of user attributes, used when WebExternalAuto is set. + +=cut + +sub WebExternalAutoInfo { + my $user = shift; + + my %user_info; + + # default to making Privileged users, even if they specify + # some other default Attributes + if ( !$RT::AutoCreate + || ( ref($RT::AutoCreate) && not exists $RT::AutoCreate->{Privileged} ) ) + { + $user_info{'Privileged'} = 1; + } + + if ( $^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/ ) { + + # Populate fields with information from Unix /etc/passwd + + my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ]; + $user_info{'Comments'} = $comments if defined $comments; + $user_info{'RealName'} = $realname if defined $realname; + } elsif ( $^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1' ) { + + # Populate fields with information from NT domain controller + } + + # and return the wad of stuff + return {%user_info}; +} + + +sub HandleRequest { + my $ARGS = shift; + + if (RT->Config->Get('DevelMode')) { + require Module::Refresh; + Module::Refresh->refresh; + } + + $HTML::Mason::Commands::r->content_type("text/html; charset=utf-8"); + + $HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ]; + + # Roll back any dangling transactions from a previous failed connection + $RT::Handle->ForceRollback() if $RT::Handle and $RT::Handle->TransactionDepth; + + MaybeEnableSQLStatementLog(); + + # avoid reentrancy, as suggested by masonbook + local *HTML::Mason::Commands::session unless $HTML::Mason::Commands::m->is_subrequest; + + $HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') ) + if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') ); + + ValidateWebConfig(); + + DecodeARGS($ARGS); + local $HTML::Mason::Commands::DECODED_ARGS = $ARGS; + PreprocessTimeUpdates($ARGS); + + InitializeMenu(); + MaybeShowInstallModePage(); + + $HTML::Mason::Commands::m->comp( '/Elements/SetupSessionCookie', %$ARGS ); + SendSessionCookie(); + + if ( _UserLoggedIn() ) { + # make user info up to date + $HTML::Mason::Commands::session{'CurrentUser'} + ->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id ); + undef $HTML::Mason::Commands::session{'CurrentUser'}->{'LangHandle'}; + } + else { + $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); + } + + # Process session-related callbacks before any auth attempts + $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Session', CallbackPage => '/autohandler' ); + + MaybeRejectPrivateComponentRequest(); + + MaybeShowNoAuthPage($ARGS); + + AttemptExternalAuth($ARGS) if RT->Config->Get('WebExternalAuthContinuous') or not _UserLoggedIn(); + + _ForceLogout() unless _UserLoggedIn(); + + # Process per-page authentication callbacks + $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' ); + + if ( $ARGS->{'NotMobile'} ) { + $HTML::Mason::Commands::session{'NotMobile'} = 1; + } + + unless ( _UserLoggedIn() ) { + _ForceLogout(); + + # Authenticate if the user is trying to login via user/pass query args + my ($authed, $msg) = AttemptPasswordAuthentication($ARGS); + + unless ($authed) { + my $m = $HTML::Mason::Commands::m; + + # REST urls get a special 401 response + if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) { + $HTML::Mason::Commands::r->content_type("text/plain"); + $m->error_format("text"); + $m->out("RT/$RT::VERSION 401 Credentials required\n"); + $m->out("\n$msg\n") if $msg; + $m->abort; + } + # Specially handle /index.html and /m/index.html so that we get a nicer URL + elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) { + my $mobile = $1 ? 1 : 0; + my $next = SetNextPage($ARGS); + $m->comp('/NoAuth/Login.html', + next => $next, + actions => [$msg], + mobile => $mobile); + $m->abort; + } + else { + TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef)); + } + } + } + + MaybeShowInterstitialCSRFPage($ARGS); + + # now it applies not only to home page, but any dashboard that can be used as a workspace + $HTML::Mason::Commands::session{'home_refresh_interval'} = $ARGS->{'HomeRefreshInterval'} + if ( $ARGS->{'HomeRefreshInterval'} ); + + # Process per-page global callbacks + $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' ); + + ShowRequestedPage($ARGS); + LogRecordedSQLStatements(RequestData => { + Path => $HTML::Mason::Commands::m->request_path, + }); + + # Process per-page final cleanup callbacks + $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Final', CallbackPage => '/autohandler' ); + + $HTML::Mason::Commands::m->comp( '/Elements/Footer', %$ARGS ) + unless $HTML::Mason::Commands::r->content_type + =~ qr<^(text|application)/(x-)?(css|javascript)>; +} + +sub _ForceLogout { + + delete $HTML::Mason::Commands::session{'CurrentUser'}; +} + +sub _UserLoggedIn { + if ( $HTML::Mason::Commands::session{CurrentUser} && $HTML::Mason::Commands::session{'CurrentUser'}->id ) { + return 1; + } else { + return undef; + } + +} + +=head2 LoginError ERROR + +Pushes a login error into the Actions session store and returns the hash key. + +=cut + +sub LoginError { + my $new = shift; + my $key = Digest::MD5::md5_hex( rand(1024) ); + push @{ $HTML::Mason::Commands::session{"Actions"}->{$key} ||= [] }, $new; + $HTML::Mason::Commands::session{'i'}++; + return $key; +} + +=head2 SetNextPage ARGSRef [PATH] + +Intuits and stashes the next page in the sesssion hash. If PATH is +specified, uses that instead of the value of L<IntuitNextPage()>. Returns +the hash value. + +=cut + +sub SetNextPage { + 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} = $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 ARGSRef [HASH] + +Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as +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 $ARGS = shift; + my $hash = SetNextPage($ARGS); + my %query = (@_, next => $hash); + + $query{mobile} = 1 + if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)}; + + my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?'; + $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query); + Redirect($login); +} + +=head2 TangentForLoginWithError ERROR + +Localizes the passed error message, stashes it with L<LoginError> and then +calls L<TangentForLogin> with the appropriate results key. + +=cut + +sub TangentForLoginWithError { + my $ARGS = shift; + my $key = LoginError(HTML::Mason::Commands::loc(@_)); + TangentForLogin( $ARGS, results => $key ); +} + +=head2 IntuitNextPage + +Attempt to figure out the path to which we should return the user after a +tangent. The current request URL is used, or failing that, the C<WebURL> +configuration variable. + +=cut + +sub IntuitNextPage { + my $req_uri; + + # This includes any query parameters. Redirect will take care of making + # it an absolute URL. + if ($ENV{'REQUEST_URI'}) { + $req_uri = $ENV{'REQUEST_URI'}; + + # collapse multiple leading slashes so the first part doesn't look like + # a hostname of a schema-less URI + $req_uri =~ s{^/+}{/}; + } + + my $next = defined $req_uri ? $req_uri : RT->Config->Get('WebURL'); + + # sanitize $next + my $uri = URI->new($next); + + # You get undef scheme with a relative uri like "/Search/Build.html" + unless (!defined($uri->scheme) || $uri->scheme eq 'http' || $uri->scheme eq 'https') { + $next = RT->Config->Get('WebURL'); + } + + # Make sure we're logging in to the same domain + # You can get an undef authority with a relative uri like "index.html" + my $uri_base_url = URI->new(RT->Config->Get('WebBaseURL')); + unless (!defined($uri->authority) || $uri->authority eq $uri_base_url->authority) { + $next = RT->Config->Get('WebURL'); + } + + return $next; +} + +=head2 MaybeShowInstallModePage + +This function, called exclusively by RT's autohandler, dispatches +a request to RT's Installation workflow, only if Install Mode is enabled in the configuration file. + +If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler + +=cut + +sub MaybeShowInstallModePage { + return unless RT->InstallMode; + + my $m = $HTML::Mason::Commands::m; + if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) { + $m->call_next(); + } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) { + RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" ); + } else { + $m->call_next(); + } + $m->abort(); +} + +=head2 MaybeShowNoAuthPage \%ARGS + +This function, called exclusively by RT's autohandler, dispatches +a request to the page a user requested (but only if it matches the "noauth" regex. + +If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler + +=cut + +sub MaybeShowNoAuthPage { + my $ARGS = shift; + + my $m = $HTML::Mason::Commands::m; + + return unless $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex'); + + # Don't show the login page to logged in users + Redirect(RT->Config->Get('WebURL')) + if $m->base_comp->path eq '/NoAuth/Login.html' and _UserLoggedIn(); + + # If it's a noauth file, don't ask for auth. + $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS ); + $m->abort; +} + +=head2 MaybeRejectPrivateComponentRequest + +This function will reject calls to private components, like those under +C</Elements>. If the requested path is a private component then we will +abort with a C<403> error. + +=cut + +sub MaybeRejectPrivateComponentRequest { + my $m = $HTML::Mason::Commands::m; + my $path = $m->request_comp->path; + + # We do not check for dhandler here, because requesting our dhandlers + # directly is okay. Mason will invoke the dhandler with a dhandler_arg of + # 'dhandler'. + + if ($path =~ m{ + / # leading slash + ( Elements | + _elements | # mobile UI + Callbacks | + Widgets | + autohandler | # requesting this directly is suspicious + l (_unsafe)? ) # loc component + ( $ | / ) # trailing slash or end of path + }xi + && $path !~ m{ /RTx/Statistics/\w+/Elements/Chart }xi + ) + { + warn "rejecting private component $path\n"; + $m->abort(403); + } + + return; +} + +sub InitializeMenu { + $HTML::Mason::Commands::m->notes('menu', RT::Interface::Web::Menu->new()); + $HTML::Mason::Commands::m->notes('page-menu', RT::Interface::Web::Menu->new()); + $HTML::Mason::Commands::m->notes('page-widgets', RT::Interface::Web::Menu->new()); + +} + + +=head2 ShowRequestedPage \%ARGS + +This function, called exclusively by RT's autohandler, dispatches +a request to the page a user requested (making sure that unpriviled users +can only see self-service pages. + +=cut + +sub ShowRequestedPage { + my $ARGS = shift; + + my $m = $HTML::Mason::Commands::m; + + # Ensure that the cookie that we send is up-to-date, in case the + # session-id has been modified in any way + SendSessionCookie(); + + # precache all system level rights for the current user + $HTML::Mason::Commands::session{CurrentUser}->PrincipalObj->HasRights( Object => RT->System ); + + # If the user isn't privileged, they can only see SelfService + unless ( $HTML::Mason::Commands::session{'CurrentUser'}->Privileged ) { + + # if the user is trying to access a ticket, redirect them + if ( $m->request_comp->path =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) { + RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} ); + } + + # otherwise, drop the user at the SelfService default page + elsif ( $m->base_comp->path !~ RT->Config->Get('SelfServiceRegex') ) { + RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/" ); + } + + # if user is in SelfService dir let him do anything + else { + $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS ); + } + } else { + $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS ); + } + +} + +sub AttemptExternalAuth { + my $ARGS = shift; + + return unless ( RT->Config->Get('WebExternalAuth') ); + + my $user = $ARGS->{user}; + my $m = $HTML::Mason::Commands::m; + + # If RT is configured for external auth, let's go through and get REMOTE_USER + + # do we actually have a REMOTE_USER equivlent? + if ( RT::Interface::Web::WebCanonicalizeInfo() ) { + my $orig_user = $user; + + $user = RT::Interface::Web::WebCanonicalizeInfo(); + my $load_method = RT->Config->Get('WebExternalGecos') ? 'LoadByGecos' : 'Load'; + + if ( $^O eq 'MSWin32' and RT->Config->Get('WebExternalGecos') ) { + my $NodeName = Win32::NodeName(); + $user =~ s/^\Q$NodeName\E\\//i; + } + + my $next = RemoveNextPage($ARGS->{'next'}); + $next = $next->{'url'} if ref $next; + InstantiateNewSession() unless _UserLoggedIn; + $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); + $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user); + + if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) { + + # Create users on-the-fly + my $UserObj = RT::User->new(RT->SystemUser); + my ( $val, $msg ) = $UserObj->Create( + %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} }, + Name => $user, + Gecos => $user, + ); + + if ($val) { + + # now get user specific information, to better create our user. + my $new_user_info = RT::Interface::Web::WebExternalAutoInfo($user); + + # set the attributes that have been defined. + foreach my $attribute ( $UserObj->WritableAttributes ) { + $m->callback( + Attribute => $attribute, + User => $user, + UserInfo => $new_user_info, + CallbackName => 'NewUser', + CallbackPage => '/autohandler' + ); + my $method = "Set$attribute"; + $UserObj->$method( $new_user_info->{$attribute} ) if defined $new_user_info->{$attribute}; + } + $HTML::Mason::Commands::session{'CurrentUser'}->Load($user); + } else { + + # we failed to successfully create the user. abort abort abort. + delete $HTML::Mason::Commands::session{'CurrentUser'}; + + if (RT->Config->Get('WebFallbackToInternalAuth')) { + TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg); + } else { + $m->abort(); + } + } + } + + if ( _UserLoggedIn() ) { + $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' ); + # It is possible that we did a redirect to the login page, + # if the external auth allows lack of auth through with no + # REMOTE_USER set, instead of forcing a "permission + # denied" message. Honor the $next. + Redirect($next) if $next; + # Unlike AttemptPasswordAuthentication below, we do not + # force a redirect to / if $next is not set -- otherwise, + # straight-up external auth would always redirect to / + # when you first hit it. + } else { + delete $HTML::Mason::Commands::session{'CurrentUser'}; + $user = $orig_user; + + unless ( RT->Config->Get('WebFallbackToInternalAuth') ) { + TangentForLoginWithError($ARGS, 'You are not an authorized user'); + } + } + } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) { + unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) { + # XXX unreachable due to prior defaulting in HandleRequest (check c34d108) + TangentForLoginWithError($ARGS, 'You are not an authorized user'); + } + } else { + + # WebExternalAuth is set, but we don't have a REMOTE_USER. abort + # XXX: we must return AUTH_REQUIRED status or we fallback to + # internal auth here too. + delete $HTML::Mason::Commands::session{'CurrentUser'} + if defined $HTML::Mason::Commands::session{'CurrentUser'}; + } +} + +sub AttemptPasswordAuthentication { + my $ARGS = shift; + return unless defined $ARGS->{user} && defined $ARGS->{pass}; + + my $user_obj = RT::CurrentUser->new(); + $user_obj->Load( $ARGS->{user} ); + + my $m = $HTML::Mason::Commands::m; + + unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) { + $RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}"); + $m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' ); + return (0, HTML::Mason::Commands::loc('Your username or password is incorrect')); + } + else { + $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}"); + + # It's important to nab the next page from the session before we blow + # the session away + my $next = RemoveNextPage($ARGS->{'next'}); + $next = $next->{'url'} if ref $next; + + InstantiateNewSession(); + $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj; + + $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' ); + + # Really the only time we don't want to redirect here is if we were + # passed user and pass as query params in the URL. + if ($next) { + Redirect($next); + } + elsif ($ARGS->{'next'}) { + # Invalid hash, but still wants to go somewhere, take them to / + Redirect(RT->Config->Get('WebURL')); + } + + return (1, HTML::Mason::Commands::loc('Logged in')); + } +} + +=head2 LoadSessionFromCookie + +Load or setup a session cookie for the current user. + +=cut + +sub _SessionCookieName { + my $cookiename = "RT_SID_" . RT->Config->Get('rtname'); + $cookiename .= "." . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'}; + return $cookiename; +} + +sub LoadSessionFromCookie { + + my %cookies = CGI::Cookie->fetch; + my $cookiename = _SessionCookieName(); + my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef ); + tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie; + unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) { + InstantiateNewSession(); + } + if ( int RT->Config->Get('AutoLogoff') ) { + my $now = int( time / 60 ); + my $last_update = $HTML::Mason::Commands::session{'_session_last_update'} || 0; + + if ( $last_update && ( $now - $last_update - RT->Config->Get('AutoLogoff') ) > 0 ) { + InstantiateNewSession(); + } + + # save session on each request when AutoLogoff is turned on + $HTML::Mason::Commands::session{'_session_last_update'} = $now if $now != $last_update; + } +} + +sub InstantiateNewSession { + tied(%HTML::Mason::Commands::session)->delete if tied(%HTML::Mason::Commands::session); + tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', undef; + SendSessionCookie(); +} + +sub SendSessionCookie { + my $cookie = CGI::Cookie->new( + -name => _SessionCookieName(), + -value => $HTML::Mason::Commands::session{_session_id}, + -path => RT->Config->Get('WebPath'), + -secure => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 ), + -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ), + ); + + $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string; +} + +=head2 Redirect URL + +This routine ells the current user's browser to redirect to URL. +Additionally, it unties the user's currently active session, helping to avoid +A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use +a cached DBI statement handle twice at the same time. + +=cut + +sub Redirect { + my $redir_to = shift; + untie $HTML::Mason::Commands::session; + my $uri = URI->new($redir_to); + my $server_uri = URI->new( _NormalizeHost(RT->Config->Get('WebURL')) ); + + # Make relative URIs absolute from the server host and scheme + $uri->scheme($server_uri->scheme) if not defined $uri->scheme; + if (not defined $uri->host) { + $uri->host($server_uri->host); + $uri->port($server_uri->port); + } + + # If the user is coming in via a non-canonical + # hostname, don't redirect them to the canonical host, + # it will just upset them (and invalidate their credentials) + # don't do this if $RT::CanonicalizeRedirectURLs is true + if ( !RT->Config->Get('CanonicalizeRedirectURLs') + && $uri->host eq $server_uri->host + && $uri->port eq $server_uri->port ) + { + if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) { + $uri->scheme('https'); + } else { + $uri->scheme('http'); + } + + # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST + $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'}); + $uri->port( $ENV{'SERVER_PORT'} ); + } + + # not sure why, but on some systems without this call mason doesn't + # set status to 302, but 200 instead and people see blank pages + $HTML::Mason::Commands::r->status(302); + + # Perlbal expects a status message, but Mason's default redirect status + # doesn't provide one. See also rt.cpan.org #36689. + $HTML::Mason::Commands::m->redirect( $uri->canonical, "302 Found" ); + + $HTML::Mason::Commands::m->abort; +} + +=head2 CacheControlExpiresHeaders + +set both Cache-Control and Expires http headers + +=cut + +sub CacheControlExpiresHeaders { + my %args = @_; + + my $Visibility = 'private'; + if ( ! defined $args{Time} ) { + $args{Time} = 0; + } elsif ( $args{Time} eq 'no-cache' ) { + $args{Time} = 0; + } elsif ( $args{Time} eq 'forever' ) { + $args{Time} = 30 * 24 * 60 * 60; + $Visibility = 'public'; + } + + my $CacheControl = $args{Time} + ? sprintf "max-age=%d, %s", $args{Time}, $Visibility + : 'no-cache' + ; + $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = $CacheControl; + + my $expires = RT::Date->new(RT->SystemUser); + $expires->SetToNow; + $expires->AddSeconds( $args{Time} ) if $args{Time}; + + $HTML::Mason::Commands::r->headers_out->{'Expires'} = $expires->RFC2616; +} + +=head2 StaticFileHeaders + +Send the browser a few headers to try to get it to (somewhat agressively) +cache RT's static Javascript and CSS files. + +This routine could really use _accurate_ heuristics. (XXX TODO) + +=cut + +sub StaticFileHeaders { + my $date = RT::Date->new(RT->SystemUser); + + # remove any cookie headers -- if it is cached publicly, it + # shouldn't include anyone's cookie! + delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'}; + + # Expire things in a month. + CacheControlExpiresHeaders( Time => 'forever' ); + + # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since' + # request, but we don't handle it and generate full reply again + # Last modified at server start time + # $date->Set( Value => $^T ); + # $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616; +} + +=head2 ComponentPathIsSafe PATH + +Takes C<PATH> and returns a boolean indicating that the user-specified partial +component path is safe. + +Currently "safe" means that the path does not start with a dot (C<.>), does +not contain a slash-dot C</.>, and does not contain any nulls. + +=cut + +sub ComponentPathIsSafe { + my $self = shift; + my $path = shift; + return($path !~ m{(?:^|/)\.} and $path !~ m{\0}); +} + +=head2 PathIsSafe + +Takes a C<< Path => path >> and returns a boolean indicating that +the path is safely within RT's control or not. The path I<must> be +relative. + +This function does not consult the filesystem at all; it is merely +a logical sanity checking of the path. This explicitly does not handle +symlinks; if you have symlinks in RT's webroot pointing outside of it, +then we assume you know what you are doing. + +=cut + +sub PathIsSafe { + my $self = shift; + my %args = @_; + my $path = $args{Path}; + + # Get File::Spec to clean up extra /s, ./, etc + my $cleaned_up = File::Spec->canonpath($path); + + if (!defined($cleaned_up)) { + $RT::Logger->info("Rejecting path that canonpath doesn't understand: $path"); + return 0; + } + + # Forbid too many ..s. We can't just sum then check because + # "../foo/bar/baz" should be illegal even though it has more + # downdirs than updirs. So as soon as we get a negative score + # (which means "breaking out" of the top level) we reject the path. + + my @components = split '/', $cleaned_up; + my $score = 0; + for my $component (@components) { + if ($component eq '..') { + $score--; + if ($score < 0) { + $RT::Logger->info("Rejecting unsafe path: $path"); + return 0; + } + } + elsif ($component eq '.' || $component eq '') { + # these two have no effect on $score + } + else { + $score++; + } + } + + return 1; +} + +=head2 SendStaticFile + +Takes a File => path and a Type => Content-type + +If Type isn't provided and File is an image, it will +figure out a sane Content-type, otherwise it will +send application/octet-stream + +Will set caching headers using StaticFileHeaders + +=cut + +sub SendStaticFile { + my $self = shift; + my %args = @_; + my $file = $args{File}; + my $type = $args{Type}; + my $relfile = $args{RelativeFile}; + + if (defined($relfile) && !$self->PathIsSafe(Path => $relfile)) { + $HTML::Mason::Commands::r->status(400); + $HTML::Mason::Commands::m->abort; + } + + $self->StaticFileHeaders(); + + unless ($type) { + if ( $file =~ /\.(gif|png|jpe?g)$/i ) { + $type = "image/$1"; + $type =~ s/jpg/jpeg/gi; + } + $type ||= "application/octet-stream"; + } + $HTML::Mason::Commands::r->content_type($type); + open( my $fh, '<', $file ) or die "couldn't open file: $!"; + binmode($fh); + { + local $/ = \16384; + $HTML::Mason::Commands::m->out($_) while (<$fh>); + $HTML::Mason::Commands::m->flush_buffer; + } + close $fh; +} + + + +sub MobileClient { + my $self = shift; + + +if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60|Mobile)/io && !$HTML::Mason::Commands::session{'NotMobile'}) { + return 1; +} else { + return undef; +} + +} + + +sub StripContent { + my %args = @_; + my $content = $args{Content}; + return '' unless $content; + + # Make the content have no 'weird' newlines in it + $content =~ s/\r+\n/\n/g; + + my $return_content = $content; + + my $html = $args{ContentType} && $args{ContentType} eq "text/html"; + my $sigonly = $args{StripSignature}; + + # massage content to easily detect if there's any real content + $content =~ s/\s+//g; # yes! remove all the spaces + if ( $html ) { + # remove html version of spaces and newlines + $content =~ s! !!g; + $content =~ s!<br/?>!!g; + } + + # Filter empty content when type is text/html + return '' if $html && $content !~ /\S/; + + # If we aren't supposed to strip the sig, just bail now. + return $return_content unless $sigonly; + + # Find the signature + my $sig = $args{'CurrentUser'}->UserObj->Signature || ''; + $sig =~ s/\s+//g; + + # Check for plaintext sig + return '' if not $html and $content =~ /^(--)?\Q$sig\E$/; + + # Check for html-formatted sig; we don't use EscapeUTF8 here + # because we want to precisely match the escapting that FCKEditor + # uses. + $sig =~ s/&/&/g; + $sig =~ s/</</g; + $sig =~ s/>/>/g; + $sig =~ s/"/"/g; + $sig =~ s/'/'/g; + return '' if $html and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s; + + # Pass it through + return $return_content; +} + +sub DecodeARGS { + my $ARGS = shift; + + %{$ARGS} = map { + + # if they've passed multiple values, they'll be an array. if they've + # passed just one, a scalar whatever they are, mark them as utf8 + my $type = ref($_); + ( !$type ) + ? Encode::is_utf8($_) + ? $_ + : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) + : ( $type eq 'ARRAY' ) + ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) } + @$_ ] + : ( $type eq 'HASH' ) + ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) } + %$_ } + : $_ + } %$ARGS; +} + +sub PreprocessTimeUpdates { + my $ARGS = shift; + + # Later in the code we use + # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS ); + # instead of $m->call_next to avoid problems with UTF8 keys in arguments. + # The call_next method pass through original arguments and if you have + # an argument with unicode key then in a next component you'll get two + # records in the args hash: one with key without UTF8 flag and another + # with the flag, which may result into errors. "{ base_comp => $m->request_comp }" + # is copied from mason's source to get the same results as we get from + # call_next method, this feature is not documented, so we just leave it + # here to avoid possible side effects. + + # This code canonicalizes time inputs in hours into minutes + foreach my $field ( keys %$ARGS ) { + next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1}; + my $local = $1; + $ARGS->{$local} =~ s{\b (?: (\d+) \s+ )? (\d+)/(\d+) \b} + {($1 || 0) + $3 ? $2 / $3 : 0}xe; + if ( $ARGS->{$field} && $ARGS->{$field} =~ /hours/i ) { + $ARGS->{$local} *= 60; + } + delete $ARGS->{$field}; + } + +} + +sub MaybeEnableSQLStatementLog { + + my $log_sql_statements = RT->Config->Get('StatementLog'); + + if ($log_sql_statements) { + $RT::Handle->ClearSQLStatementLog; + $RT::Handle->LogSQLStatements(1); + } + +} + +sub LogRecordedSQLStatements { + my %args = @_; + + my $log_sql_statements = RT->Config->Get('StatementLog'); + + return unless ($log_sql_statements); + + my @log = $RT::Handle->SQLStatementLog; + $RT::Handle->ClearSQLStatementLog; + + $RT::Handle->AddRequestToHistory({ + %{ $args{RequestData} }, + Queries => \@log, + }); + + for my $stmt (@log) { + my ( $time, $sql, $bind, $duration ) = @{$stmt}; + my @bind; + if ( ref $bind ) { + @bind = @{$bind}; + } else { + + # Older DBIx-SB + $duration = $bind; + } + $RT::Logger->log( + level => $log_sql_statements, + message => "SQL(" + . sprintf( "%.6f", $duration ) + . "s): $sql;" + . ( @bind ? " [ bound values: @{[map{ defined $_ ? qq|'$_'| : 'undef'} @bind]} ]" : "" ) + ); + } + +} + +my $_has_validated_web_config = 0; +sub ValidateWebConfig { + my $self = shift; + + # do this once per server instance, not once per request + return if $_has_validated_web_config; + $_has_validated_web_config = 1; + + my $port = $ENV{SERVER_PORT}; + my $host = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER} + || $ENV{HTTP_HOST} || $ENV{SERVER_NAME}; + ($host, $port) = ($1, $2) if $host =~ /^(.*?):(\d+)$/; + + if ( $port != RT->Config->Get('WebPort') and not $ENV{'rt.explicit_port'}) { + $RT::Logger->warn("The requested port ($port) does NOT match the configured WebPort ($RT::WebPort). " + ."Perhaps you should Set(\$WebPort, $port); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); + } + + if ( $host ne RT->Config->Get('WebDomain') ) { + $RT::Logger->warn("The requested host ($host) does NOT match the configured WebDomain ($RT::WebDomain). " + ."Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); + } + + return; #next warning flooding our logs, doesn't seem applicable to our use + # (SCRIPT_NAME is the full path, WebPath is just the beginning) + #in vanilla RT does something eat the local part of SCRIPT_NAME 1st? + + # Unfortunately, there is no reliable way to get the _path_ that was + # requested at the proxy level; simply disable this warning if we're + # proxied and there's a mismatch. + my $proxied = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER}; + if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath') and not $proxied) { + $RT::Logger->warn("The requested path ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). " + ."Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); + } +} + +sub ComponentRoots { + my $self = shift; + my %args = ( Names => 0, @_ ); + my @roots; + if (defined $HTML::Mason::Commands::m) { + @roots = $HTML::Mason::Commands::m->interp->comp_root_array; + } else { + @roots = ( + [ local => $RT::MasonLocalComponentRoot ], + (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}), + [ standard => $RT::MasonComponentRoot ] + ); + } + @roots = map { $_->[1] } @roots unless $args{Names}; + return @roots; +} + +our %is_whitelisted_component = ( + # The RSS feed embeds an auth token in the path, but query + # information for the search. Because it's a straight-up read, in + # addition to embedding its own auth, it's fine. + '/NoAuth/rss/dhandler' => 1, + + # While these can be used for denial-of-service against RT + # (construct a very inefficient query and trick lots of users into + # running them against RT) it's incredibly useful to be able to link + # to a search result (or chart) or bookmark a result page. + '/Search/Results.html' => 1, + '/Search/Simple.html' => 1, + '/m/tickets/search' => 1, + '/Search/Chart.html' => 1, + + # This page takes Attachment and Transaction argument to figure + # out what to show, but it's read only and will deny information if you + # don't have ShowOutgoingEmail. + '/Ticket/ShowEmailRecord.html' => 1, +); + +# Components which are blacklisted from automatic, argument-based whitelisting. +# These pages are not idempotent when called with just an id. +our %is_blacklisted_component = ( + # Takes only id and toggles bookmark state + '/Helpers/Toggle/TicketBookmark' => 1, +); + +sub IsCompCSRFWhitelisted { + my $comp = shift; + my $ARGS = shift; + + return 1 if $is_whitelisted_component{$comp}; + + my %args = %{ $ARGS }; + + # If the user specifies a *correct* user and pass then they are + # golden. This acts on the presumption that external forms may + # hardcode a username and password -- if a malicious attacker knew + # both already, CSRF is the least of your problems. + my $AllowLoginCSRF = not RT->Config->Get('RestrictReferrerLogin'); + if ($AllowLoginCSRF and defined($args{user}) and defined($args{pass})) { + my $user_obj = RT::CurrentUser->new(); + $user_obj->Load($args{user}); + return 1 if $user_obj->id && $user_obj->IsPassword($args{pass}); + + delete $args{user}; + 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. + delete $args{id}; + + # If they have a results= from MaybeRedirectForResults, that's also fine. + delete $args{results}; + + # The homepage refresh, which uses the Refresh header, doesn't send + # a referer in most browsers; whitelist the one parameter it reloads + # with, HomeRefreshInterval, which is safe + delete $args{HomeRefreshInterval}; + + # The NotMobile flag is fine for any page; it's only used to toggle a flag + # in the session related to which interface you get. + delete $args{NotMobile}; + + # If there are no arguments, then it's likely to be an idempotent + # request, which are not susceptible to CSRF + return 1 if !%args; + + return 0; +} + +sub IsRefererCSRFWhitelisted { + my $referer = _NormalizeHost(shift); + my $base_url = _NormalizeHost(RT->Config->Get('WebBaseURL')); + $base_url = $base_url->host_port; + + my $configs; + for my $config ( $base_url, RT->Config->Get('ReferrerWhitelist') ) { + push @$configs,$config; + + my $host_port = $referer->host_port; + if ($config =~ /\*/) { + # Turn a literal * into a domain component or partial component match. + # Refer to http://tools.ietf.org/html/rfc2818#page-5 + my $regex = join "[a-zA-Z0-9\-]*", + map { quotemeta($_) } + split /\*/, $config; + + return 1 if $host_port =~ /^$regex$/i; + } else { + return 1 if $host_port eq $config; + } + } + + return (0,$referer,$configs); +} + +=head3 _NormalizeHost + +Takes a URI and creates a URI object that's been normalized +to handle common problems such as localhost vs 127.0.0.1 + +=cut + +sub _NormalizeHost { + my $s = shift; + $s = "http://$s" unless $s =~ /^http/i; + my $uri= URI->new($s); + $uri->host('127.0.0.1') if $uri->host eq 'localhost'; + + return $uri; + +} + +sub IsPossibleCSRF { + my $ARGS = shift; + + # If first request on this session is to a REST endpoint, then + # whitelist the REST endpoints -- and explicitly deny non-REST + # endpoints. We do this because using a REST cookie in a browser + # would open the user to CSRF attacks to the REST endpoints. + my $path = $HTML::Mason::Commands::r->path_info; + $HTML::Mason::Commands::session{'REST'} = $path =~ m{^/+REST/\d+\.\d+(/|$)} + unless defined $HTML::Mason::Commands::session{'REST'}; + + if ($HTML::Mason::Commands::session{'REST'}) { + return 0 if $path =~ m{^/+REST/\d+\.\d+(/|$)}; + my $why = <<EOT; +This login session belongs to a REST client, and cannot be used to +access non-REST interfaces of RT for security reasons. +EOT + my $details = <<EOT; +Please log out and back in to obtain a session for normal browsing. If +you understand the security implications, disabling RT's CSRF protection +will remove this restriction. +EOT + chomp $details; + HTML::Mason::Commands::Abort( $why, Details => $details ); + } + + return 0 if IsCompCSRFWhitelisted( + $HTML::Mason::Commands::m->request_comp->path, + $ARGS + ); + + # if there is no Referer header then assume the worst + return (1, + "your browser did not supply a Referrer header", # loc + ) if !$ENV{HTTP_REFERER}; + + my ($whitelisted, $browser, $configs) = IsRefererCSRFWhitelisted($ENV{HTTP_REFERER}); + return 0 if $whitelisted; + + if ( @$configs > 1 ) { + return (1, + "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2]) or whitelisted hosts ([_3])", # loc + $browser->host_port, + shift @$configs, + join(', ', @$configs) ); + } + + return (1, + "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2])", # loc + $browser->host_port, + $configs->[0]); +} + +sub ExpandCSRFToken { + my $ARGS = shift; + + my $token = delete $ARGS->{CSRF_Token}; + return unless $token; + + my $data = $HTML::Mason::Commands::session{'CSRF'}{$token}; + return unless $data; + return unless $data->{path} eq $HTML::Mason::Commands::r->path_info; + + my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj; + return unless $user->ValidateAuthString( $data->{auth}, $token ); + + %{$ARGS} = %{$data->{args}}; + $HTML::Mason::Commands::DECODED_ARGS = $ARGS; + + # We explicitly stored file attachments with the request, but not in + # the session yet, as that would itself be an attack. Put them into + # the session now, so they'll be visible. + if ($data->{attach}) { + my $filename = $data->{attach}{filename}; + my $mime = $data->{attach}{mime}; + $HTML::Mason::Commands::session{'Attachments'}{$filename} + = $mime; + } + + return 1; +} + +sub StoreRequestToken { + my $ARGS = shift; + + my $token = Digest::MD5::md5_hex(time . {} . $$ . rand(1024)); + my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj; + my $data = { + auth => $user->GenerateAuthString( $token ), + path => $HTML::Mason::Commands::r->path_info, + args => $ARGS, + }; + if ($ARGS->{Attach}) { + my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' ); + my $file_path = delete $ARGS->{'Attach'}; + $data->{attach} = { + filename => Encode::decode_utf8("$file_path"), + mime => $attachment, + }; + } + + $HTML::Mason::Commands::session{'CSRF'}->{$token} = $data; + $HTML::Mason::Commands::session{'i'}++; + return $token; +} + +sub MaybeShowInterstitialCSRFPage { + my $ARGS = shift; + + return unless RT->Config->Get('RestrictReferrer'); + + # Deal with the form token provided by the interstitial, which lets + # browsers which never set referer headers still use RT, if + # painfully. This blows values into ARGS + return if ExpandCSRFToken($ARGS); + + my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS); + return if !$is_csrf; + + $RT::Logger->notice("Possible CSRF: ".RT::CurrentUser->new->loc($msg, @loc)); + + my $token = StoreRequestToken($ARGS); + $HTML::Mason::Commands::m->comp( + '/Elements/CSRF', + OriginalURL => RT->Config->Get('WebPath') . $HTML::Mason::Commands::r->path_info, + Reason => HTML::Mason::Commands::loc( $msg, @loc ), + Token => $token, + ); + # 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/; + +sub Menu { + return $HTML::Mason::Commands::m->notes('menu'); +} + +sub PageMenu { + return $HTML::Mason::Commands::m->notes('page-menu'); +} + +sub PageWidgets { + return $HTML::Mason::Commands::m->notes('page-widgets'); +} + + + +=head2 loc ARRAY + +loc is a nice clean global routine which calls $session{'CurrentUser'}->loc() +with whatever it's called with. If there is no $session{'CurrentUser'}, +it creates a temporary user, so we have something to get a localisation handle +through + +=cut + +sub loc { + + if ( $session{'CurrentUser'} + && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) ) + { + return ( $session{'CurrentUser'}->loc(@_) ); + } elsif ( + my $u = eval { + RT::CurrentUser->new(); + } + ) + { + return ( $u->loc(@_) ); + } else { + + # pathetic case -- SystemUser is gone. + return $_[0]; + } +} + + + +=head2 loc_fuzzy STRING + +loc_fuzzy is for handling localizations of messages that may already +contain interpolated variables, typically returned from libraries +outside RT's control. It takes the message string and extracts the +variable array automatically by matching against the candidate entries +inside the lexicon file. + +=cut + +sub loc_fuzzy { + my $msg = shift; + + if ( $session{'CurrentUser'} + && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) ) + { + return ( $session{'CurrentUser'}->loc_fuzzy($msg) ); + } else { + my $u = RT::CurrentUser->new( RT->SystemUser->Id ); + return ( $u->loc_fuzzy($msg) ); + } +} + + +# Error - calls Error and aborts +sub Abort { + my $why = shift; + my %args = @_; + + if ( $session{'ErrorDocument'} + && $session{'ErrorDocumentType'} ) + { + $r->content_type( $session{'ErrorDocumentType'} ); + $m->comp( $session{'ErrorDocument'}, Why => $why, %args ); + $m->abort; + } else { + $m->comp( "/Elements/Error", Why => $why, %args ); + $m->abort; + } +} + +sub MaybeRedirectForResults { + my %args = ( + Path => $HTML::Mason::Commands::m->request_comp->path, + Arguments => {}, + Anchor => undef, + Actions => undef, + Force => 0, + @_ + ); + my $has_actions = $args{'Actions'} && grep( defined, @{ $args{'Actions'} } ); + return unless $has_actions || $args{'Force'}; + + my %arguments = %{ $args{'Arguments'} }; + + if ( $has_actions ) { + my $key = Digest::MD5::md5_hex( rand(1024) ); + push @{ $session{"Actions"}{ $key } ||= [] }, @{ $args{'Actions'} }; + $session{'i'}++; + $arguments{'results'} = $key; + } + + $args{'Path'} =~ s!^/+!!; + my $url = RT->Config->Get('WebURL') . $args{Path}; + + if ( keys %arguments ) { + $url .= '?'. $m->comp( '/Elements/QueryString', %arguments ); + } + if ( $args{'Anchor'} ) { + $url .= "#". $args{'Anchor'}; + } + return RT::Interface::Web::Redirect($url); +} + +=head2 MaybeRedirectToApproval Path => 'path', Whitelist => REGEX, ARGSRef => HASHREF + +If the ticket specified by C<< $ARGSRef->{id} >> is an approval ticket, +redirect to the approvals display page, preserving any arguments. + +C<Path>s matching C<Whitelist> are let through. + +This is a no-op if the C<ForceApprovalsView> option isn't enabled. + +=cut + +sub MaybeRedirectToApproval { + my %args = ( + Path => $HTML::Mason::Commands::m->request_comp->path, + ARGSRef => {}, + Whitelist => undef, + @_ + ); + + return unless $ENV{REQUEST_METHOD} eq 'GET'; + + my $id = $args{ARGSRef}->{id}; + + if ( $id + and RT->Config->Get('ForceApprovalsView') + and not $args{Path} =~ /$args{Whitelist}/) + { + my $ticket = RT::Ticket->new( $session{'CurrentUser'} ); + $ticket->Load($id); + + if ($ticket and $ticket->id and lc($ticket->Type) eq 'approval') { + MaybeRedirectForResults( + Path => "/Approvals/Display.html", + Force => 1, + Anchor => $args{ARGSRef}->{Anchor}, + Arguments => $args{ARGSRef}, + ); + } + } +} + +=head2 CreateTicket ARGS + +Create a new ticket, using Mason's %ARGS. returns @results. + +=cut + +sub CreateTicket { + my %ARGS = (@_); + + my (@Actions); + + my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); + + my $Queue = RT::Queue->new( $session{'CurrentUser'} ); + unless ( $Queue->Load( $ARGS{'Queue'} ) ) { + Abort('Queue not found'); + } + + unless ( $Queue->CurrentUserHasRight('CreateTicket') ) { + Abort('You have no permission to create tickets in that queue.'); + } + + my $due; + if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) { + $due = RT::Date->new( $session{'CurrentUser'} ); + $due->Set( Format => 'unknown', Value => $ARGS{'Due'} ); + } + my $starts; + if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) { + $starts = RT::Date->new( $session{'CurrentUser'} ); + $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} ); + } + + my $sigless = RT::Interface::Web::StripContent( + Content => $ARGS{Content}, + ContentType => $ARGS{ContentType}, + StripSignature => 1, + CurrentUser => $session{'CurrentUser'}, + ); + + my $MIMEObj = MakeMIMEEntity( + Subject => $ARGS{'Subject'}, + From => $ARGS{'From'}, + Cc => $ARGS{'Cc'}, + Body => $sigless, + Type => $ARGS{'ContentType'}, + Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', + ); + + if ( $ARGS{'Attachments'} ) { + my $rv = $MIMEObj->make_multipart; + $RT::Logger->error("Couldn't make multipart message") + if !$rv || $rv !~ /^(?:DONE|ALREADY)$/; + + foreach ( map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} } ) { + unless ($_) { + $RT::Logger->error("Couldn't add empty attachemnt"); + next; + } + $MIMEObj->add_part($_); + } + } + + for my $argument (qw(Encrypt Sign)) { + $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ); + } + + my %create_args = ( + Type => $ARGS{'Type'} || 'ticket', + Queue => $ARGS{'Queue'}, + Owner => $ARGS{'Owner'}, + + # note: name change + Requestor => $ARGS{'Requestors'}, + Cc => $ARGS{'Cc'}, + AdminCc => $ARGS{'AdminCc'}, + InitialPriority => $ARGS{'InitialPriority'}, + FinalPriority => $ARGS{'FinalPriority'}, + TimeLeft => $ARGS{'TimeLeft'}, + TimeEstimated => $ARGS{'TimeEstimated'}, + TimeWorked => $ARGS{'TimeWorked'}, + Subject => $ARGS{'Subject'}, + Status => $ARGS{'Status'}, + Due => $due ? $due->ISO : undef, + Starts => $starts ? $starts->ISO : undef, + MIMEObj => $MIMEObj + ); + + my @txn_squelch; + foreach my $type (qw(Requestor Cc AdminCc)) { + push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} ) + if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] }; + } + $create_args{TransSquelchMailTo} = \@txn_squelch + if @txn_squelch; + + if ( $ARGS{'AttachTickets'} ) { + require RT::Action::SendEmail; + RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets, + ref $ARGS{'AttachTickets'} + ? @{ $ARGS{'AttachTickets'} } + : ( $ARGS{'AttachTickets'} ) ); + } + + foreach my $arg ( keys %ARGS ) { + next if $arg =~ /-(?:Magic|Category)$/; + + if ( $arg =~ /^Object-RT::Transaction--CustomField-/ ) { + $create_args{$arg} = $ARGS{$arg}; + } + + # Object-RT::Ticket--CustomField-3-Values + elsif ( $arg =~ /^Object-RT::Ticket--CustomField-(\d+)/ ) { + my $cfid = $1; + + my $cf = RT::CustomField->new( $session{'CurrentUser'} ); + $cf->SetContextObject( $Queue ); + $cf->Load($cfid); + unless ( $cf->id ) { + $RT::Logger->error( "Couldn't load custom field #" . $cfid ); + next; + } + + if ( $arg =~ /-Upload$/ ) { + $create_args{"CustomField-$cfid"} = _UploadedFile($arg); + next; + } + + my $type = $cf->Type; + + my @values = (); + if ( ref $ARGS{$arg} eq 'ARRAY' ) { + @values = @{ $ARGS{$arg} }; + } elsif ( $type =~ /text/i ) { + @values = ( $ARGS{$arg} ); + } else { + no warnings 'uninitialized'; + @values = split /\r*\n/, $ARGS{$arg}; + } + @values = grep length, map { + s/\r+\n/\n/g; + s/^\s+//; + s/\s+$//; + $_; + } + grep defined, @values; + + $create_args{"CustomField-$cfid"} = \@values; + } + } + + # turn new link lists into arrays, and pass in the proper arguments + my %map = ( + 'new-DependsOn' => 'DependsOn', + 'DependsOn-new' => 'DependedOnBy', + 'new-MemberOf' => 'Parents', + 'MemberOf-new' => 'Children', + 'new-RefersTo' => 'RefersTo', + 'RefersTo-new' => 'ReferredToBy', + ); + foreach my $key ( keys %map ) { + next unless $ARGS{$key}; + $create_args{ $map{$key} } = [ grep $_, split ' ', $ARGS{$key} ]; + + } + + my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); + unless ($id) { + Abort($ErrMsg); + } + + push( @Actions, split( "\n", $ErrMsg ) ); + unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) { + Abort( "No permission to view newly created ticket #" . $Ticket->id . "." ); + } + return ( $Ticket, @Actions ); + +} + + + +=head2 LoadTicket id + +Takes a ticket id as its only variable. if it's handed an array, it takes +the first value. + +Returns an RT::Ticket object as the current user. + +=cut + +sub LoadTicket { + my $id = shift; + + if ( ref($id) eq "ARRAY" ) { + $id = $id->[0]; + } + + unless ($id) { + Abort("No ticket specified"); + } + + my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); + $Ticket->Load($id); + unless ( $Ticket->id ) { + Abort("Could not load ticket $id"); + } + return $Ticket; +} + + + +=head2 ProcessUpdateMessage + +Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly. + +Don't write message if it only contains current user's signature and +SkipSignatureOnly argument is true. Function anyway adds attachments +and updates time worked field even if skips message. The default value +is true. + +=cut + +# change from stock: if txn custom fields are set but there's no content +# or attachment, create a Touch txn instead of doing nothing + +sub ProcessUpdateMessage { + + my %args = ( + ARGSRef => undef, + TicketObj => undef, + SkipSignatureOnly => 1, + @_ + ); + + if ( $args{ARGSRef}->{'UpdateAttachments'} + && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } ) + { + delete $args{ARGSRef}->{'UpdateAttachments'}; + } + + # Strip the signature + $args{ARGSRef}->{UpdateContent} = RT::Interface::Web::StripContent( + Content => $args{ARGSRef}->{UpdateContent}, + ContentType => $args{ARGSRef}->{UpdateContentType}, + StripSignature => $args{SkipSignatureOnly}, + CurrentUser => $args{'TicketObj'}->CurrentUser, + ); + + my %txn_customfields; + + foreach my $key ( keys %{ $args{ARGSRef} } ) { + if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) { + next if $key =~ /(TimeUnits|Magic)$/; + $txn_customfields{$key} = $args{ARGSRef}->{$key}; + } + } + + # If, after stripping the signature, we have no message, create a + # Touch transaction if necessary + if ( not $args{ARGSRef}->{'UpdateAttachments'} + and not length $args{ARGSRef}->{'UpdateContent'} ) + { + #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) { + # $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + + # delete $args{ARGSRef}->{'UpdateTimeWorked'}; + # } + + my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'}; + if ( $timetaken or grep {length $_} values %txn_customfields ) { + my ( $Transaction, $Description, $Object ) = + $args{TicketObj}->Touch( + CustomFields => \%txn_customfields, + TimeTaken => $timetaken + ); + return $Description; + } + return; + } + + if ( $args{ARGSRef}->{'UpdateSubject'} eq ($args{'TicketObj'}->Subject || '') ) { + $args{ARGSRef}->{'UpdateSubject'} = undef; + } + + my $Message = MakeMIMEEntity( + Subject => $args{ARGSRef}->{'UpdateSubject'}, + Body => $args{ARGSRef}->{'UpdateContent'}, + Type => $args{ARGSRef}->{'UpdateContentType'}, + Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', + ); + + $Message->head->replace( 'Message-ID' => Encode::encode_utf8( + RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} ) + ) ); + my $old_txn = RT::Transaction->new( $session{'CurrentUser'} ); + if ( $args{ARGSRef}->{'QuoteTransaction'} ) { + $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} ); + } else { + $old_txn = $args{TicketObj}->Transactions->First(); + } + + if ( my $msg = $old_txn->Message->First ) { + RT::Interface::Email::SetInReplyTo( + Message => $Message, + InReplyTo => $msg + ); + } + + if ( $args{ARGSRef}->{'UpdateAttachments'} ) { + $Message->make_multipart; + $Message->add_part($_) foreach map $args{ARGSRef}->{UpdateAttachments}{$_}, + sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} }; + } + + if ( $args{ARGSRef}->{'AttachTickets'} ) { + require RT::Action::SendEmail; + RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets, + ref $args{ARGSRef}->{'AttachTickets'} + ? @{ $args{ARGSRef}->{'AttachTickets'} } + : ( $args{ARGSRef}->{'AttachTickets'} ) ); + } + + my %message_args = ( + Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ), + Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ), + MIMEObj => $Message, + TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}, + CustomFields => \%txn_customfields, + ); + + _ProcessUpdateMessageRecipients( + MessageArgs => \%message_args, + %args, + ); + + my @results; + if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) { + my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args); + push( @results, $Description ); + $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object; + } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) { + my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args); + push( @results, $Description ); + $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object; + } else { + push( @results, + loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") ); + } + return @results; +} + +sub _ProcessUpdateMessageRecipients { + my %args = ( + ARGSRef => undef, + TicketObj => undef, + MessageArgs => undef, + @_, + ); + + my $bcc = $args{ARGSRef}->{'UpdateBcc'}; + my $cc = $args{ARGSRef}->{'UpdateCc'}; + + my $message_args = $args{MessageArgs}; + + $message_args->{CcMessageTo} = $cc; + $message_args->{BccMessageTo} = $bcc; + + my @txn_squelch; + foreach my $type (qw(Cc AdminCc)) { + if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) { + push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{$type} ); + push @txn_squelch, $args{TicketObj}->$type->MemberEmailAddresses; + push @txn_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses; + } + } + if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) { + push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} ); + push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses; + } + + push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo}; + $message_args->{SquelchMailTo} = \@txn_squelch + if @txn_squelch; + + unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) { + foreach my $key ( keys %{ $args{ARGSRef} } ) { + next unless $key =~ /^Update(Cc|Bcc)-(.*)$/; + + my $var = ucfirst($1) . 'MessageTo'; + my $value = $2; + if ( $message_args->{$var} ) { + $message_args->{$var} .= ", $value"; + } else { + $message_args->{$var} = $value; + } + } + } +} + +sub ProcessAttachments { + my %args = ( + ARGSRef => {}, + @_ + ); + + my $ARGSRef = $args{ARGSRef} || {}; + # deal with deleting uploaded attachments + foreach my $key ( keys %$ARGSRef ) { + if ( $key =~ m/^DeleteAttach-(.+)$/ ) { + delete $session{'Attachments'}{$1}; + } + $session{'Attachments'} = { %{ $session{'Attachments'} || {} } }; + } + + # store the uploaded attachment in session + if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} ) + { # attachment? + my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' ); + + my $file_path = Encode::decode_utf8("$ARGSRef->{'Attach'}"); + $session{'Attachments'} = + { %{ $session{'Attachments'} || {} }, $file_path => $attachment, }; + } + + # delete temporary storage entry to make WebUI clean + unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} ) + { + delete $session{'Attachments'}; + } +} + + +=head2 MakeMIMEEntity PARAMHASH + +Takes a paramhash Subject, Body and AttachmentFieldName. + +Also takes Form, Cc and Type as optional paramhash keys. + + Returns a MIME::Entity. + +=cut + +sub MakeMIMEEntity { + + #TODO document what else this takes. + my %args = ( + Subject => undef, + From => undef, + Cc => undef, + Body => undef, + AttachmentFieldName => undef, + Type => undef, + Interface => 'API', + @_, + ); + my $Message = MIME::Entity->build( + Type => 'multipart/mixed', + "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ), + "X-RT-Interface" => $args{Interface}, + map { $_ => Encode::encode_utf8( $args{ $_} ) } + grep defined $args{$_}, qw(Subject From Cc) + ); + + if ( defined $args{'Body'} && length $args{'Body'} ) { + + # Make the update content have no 'weird' newlines in it + $args{'Body'} =~ s/\r\n/\n/gs; + + $Message->attach( + Type => $args{'Type'} || 'text/plain', + Charset => 'UTF-8', + Data => $args{'Body'}, + ); + } + + if ( $args{'AttachmentFieldName'} ) { + + my $cgi_object = $m->cgi_object; + my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ); + if ( defined $filehandle && length $filehandle ) { + + my ( @content, $buffer ); + while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) { + push @content, $buffer; + } + + my $uploadinfo = $cgi_object->uploadInfo($filehandle); + + my $filename = "$filehandle"; + $filename =~ s{^.*[\\/]}{}; + + $Message->attach( + Type => $uploadinfo->{'Content-Type'}, + Filename => $filename, + Data => \@content, + ); + if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) { + $Message->head->set( 'Subject' => $filename ); + } + + # Attachment parts really shouldn't get a Message-ID or "interface" + $Message->head->delete('Message-ID'); + $Message->head->delete('X-RT-Interface'); + } + } + + $Message->make_singlepart; + + RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8 + + return ($Message); + +} + + + +=head2 ParseDateToISO + +Takes a date in an arbitrary format. +Returns an ISO date and time in GMT + +=cut + +sub ParseDateToISO { + my $date = shift; + + my $date_obj = RT::Date->new( $session{'CurrentUser'} ); + $date_obj->Set( + Format => 'unknown', + Value => $date + ); + return ( $date_obj->ISO ); +} + + + +sub ProcessACLChanges { + my $ARGSref = shift; + + my @results; + + foreach my $arg ( keys %$ARGSref ) { + next unless ( $arg =~ /^(GrantRight|RevokeRight)-(\d+)-(.+?)-(\d+)$/ ); + + my ( $method, $principal_id, $object_type, $object_id ) = ( $1, $2, $3, $4 ); + + my @rights; + if ( UNIVERSAL::isa( $ARGSref->{$arg}, 'ARRAY' ) ) { + @rights = @{ $ARGSref->{$arg} }; + } else { + @rights = $ARGSref->{$arg}; + } + @rights = grep $_, @rights; + next unless @rights; + + my $principal = RT::Principal->new( $session{'CurrentUser'} ); + $principal->Load($principal_id); + + my $obj; + if ( $object_type eq 'RT::System' ) { + $obj = $RT::System; + } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) { + $obj = $object_type->new( $session{'CurrentUser'} ); + $obj->Load($object_id); + unless ( $obj->id ) { + $RT::Logger->error("couldn't load $object_type #$object_id"); + next; + } + } else { + $RT::Logger->error("object type '$object_type' is incorrect"); + push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) ); + next; + } + + foreach my $right (@rights) { + my ( $val, $msg ) = $principal->$method( Object => $obj, Right => $right ); + push( @results, $msg ); + } + } + + return (@results); +} + + +=head2 ProcessACLs + +ProcessACLs expects values from a series of checkboxes that describe the full +set of rights a principal should have on an object. + +It expects form inputs with names like SetRights-PrincipalId-ObjType-ObjId +instead of with the prefixes Grant/RevokeRight. Each input should be an array +listing the rights the principal should have, and ProcessACLs will modify the +current rights to match. Additionally, the previously unused CheckACL input +listing PrincipalId-ObjType-ObjId is now used to catch cases when all the +rights are removed from a principal and as such no SetRights input is +submitted. + +=cut + +sub ProcessACLs { + my $ARGSref = shift; + my (%state, @results); + + my $CheckACL = $ARGSref->{'CheckACL'}; + my @check = grep { defined } (ref $CheckACL eq 'ARRAY' ? @$CheckACL : $CheckACL); + + # Check if we want to grant rights to a previously rights-less user + for my $type (qw(user group)) { + my $principal = _ParseACLNewPrincipal($ARGSref, $type) + or next; + + unless ($principal->PrincipalId) { + push @results, loc("Couldn't load the specified principal"); + next; + } + + my $principal_id = $principal->PrincipalId; + + # Turn our addprincipal rights spec into a real one + for my $arg (keys %$ARGSref) { + next unless $arg =~ /^SetRights-addprincipal-(.+?-\d+)$/; + + my $tuple = "$principal_id-$1"; + my $key = "SetRights-$tuple"; + + # If we have it already, that's odd, but merge them + if (grep { $_ eq $tuple } @check) { + $ARGSref->{$key} = [ + (ref $ARGSref->{$key} eq 'ARRAY' ? @{$ARGSref->{$key}} : $ARGSref->{$key}), + (ref $ARGSref->{$arg} eq 'ARRAY' ? @{$ARGSref->{$arg}} : $ARGSref->{$arg}), + ]; + } else { + $ARGSref->{$key} = $ARGSref->{$arg}; + push @check, $tuple; + } + } + } + + # Build our rights state for each Principal-Object tuple + foreach my $arg ( keys %$ARGSref ) { + next unless $arg =~ /^SetRights-(\d+-.+?-\d+)$/; + + my $tuple = $1; + my $value = $ARGSref->{$arg}; + my @rights = grep { $_ } (ref $value eq 'ARRAY' ? @$value : $value); + next unless @rights; + + $state{$tuple} = { map { $_ => 1 } @rights }; + } + + foreach my $tuple (List::MoreUtils::uniq @check) { + next unless $tuple =~ /^(\d+)-(.+?)-(\d+)$/; + + my ( $principal_id, $object_type, $object_id ) = ( $1, $2, $3 ); + + my $principal = RT::Principal->new( $session{'CurrentUser'} ); + $principal->Load($principal_id); + + my $obj; + if ( $object_type eq 'RT::System' ) { + $obj = $RT::System; + } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) { + $obj = $object_type->new( $session{'CurrentUser'} ); + $obj->Load($object_id); + unless ( $obj->id ) { + $RT::Logger->error("couldn't load $object_type #$object_id"); + next; + } + } else { + $RT::Logger->error("object type '$object_type' is incorrect"); + push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) ); + next; + } + + my $acls = RT::ACL->new($session{'CurrentUser'}); + $acls->LimitToObject( $obj ); + $acls->LimitToPrincipal( Id => $principal_id ); + + while ( my $ace = $acls->Next ) { + my $right = $ace->RightName; + + # Has right and should have right + next if delete $state{$tuple}->{$right}; + + # Has right and shouldn't have right + my ($val, $msg) = $principal->RevokeRight( Object => $obj, Right => $right ); + push @results, $msg; + } + + # For everything left, they don't have the right but they should + for my $right (keys %{ $state{$tuple} || {} }) { + delete $state{$tuple}->{$right}; + my ($val, $msg) = $principal->GrantRight( Object => $obj, Right => $right ); + push @results, $msg; + } + + # Check our state for leftovers + if ( keys %{ $state{$tuple} || {} } ) { + my $missed = join '|', %{$state{$tuple} || {}}; + $RT::Logger->warn( + "Uh-oh, it looks like we somehow missed a right in " + ."ProcessACLs. Here's what was leftover: $missed" + ); + } + } + + return (@results); +} + +=head2 _ParseACLNewPrincipal + +Takes a hashref of C<%ARGS> and a principal type (C<user> or C<group>). Looks +for the presence of rights being added on a principal of the specified type, +and returns undef if no new principal is being granted rights. Otherwise loads +up an L<RT::User> or L<RT::Group> object and returns it. Note that the object +may not be successfully loaded, and you should check C<->id> yourself. + +=cut + +sub _ParseACLNewPrincipal { + my $ARGSref = shift; + my $type = lc shift; + my $key = "AddPrincipalForRights-$type"; + + return unless $ARGSref->{$key}; + + my $principal; + if ( $type eq 'user' ) { + $principal = RT::User->new( $session{'CurrentUser'} ); + $principal->LoadByCol( Name => $ARGSref->{$key} ); + } + elsif ( $type eq 'group' ) { + $principal = RT::Group->new( $session{'CurrentUser'} ); + $principal->LoadUserDefinedGroup( $ARGSref->{$key} ); + } + return $principal; +} + + +=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs) + +@attribs is a list of ticket fields to check and update if they differ from the B<Object>'s current values. ARGSRef is a ref to HTML::Mason's %ARGS. + +Returns an array of success/failure messages + +=cut + +sub UpdateRecordObject { + my %args = ( + ARGSRef => undef, + AttributesRef => undef, + Object => undef, + AttributePrefix => undef, + @_ + ); + + my $Object = $args{'Object'}; + my @results = $Object->Update( + AttributesRef => $args{'AttributesRef'}, + ARGSRef => $args{'ARGSRef'}, + AttributePrefix => $args{'AttributePrefix'}, + ); + + return (@results); +} + + + +sub ProcessCustomFieldUpdates { + my %args = ( + CustomFieldObj => undef, + ARGSRef => undef, + @_ + ); + + my $Object = $args{'CustomFieldObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my @attribs = qw(Name Type Description Queue SortOrder); + my @results = UpdateRecordObject( + AttributesRef => \@attribs, + Object => $Object, + ARGSRef => $ARGSRef + ); + + my $prefix = "CustomField-" . $Object->Id; + if ( $ARGSRef->{"$prefix-AddValue-Name"} ) { + my ( $addval, $addmsg ) = $Object->AddValue( + Name => $ARGSRef->{"$prefix-AddValue-Name"}, + Description => $ARGSRef->{"$prefix-AddValue-Description"}, + SortOrder => $ARGSRef->{"$prefix-AddValue-SortOrder"}, + ); + push( @results, $addmsg ); + } + + my @delete_values + = ( ref $ARGSRef->{"$prefix-DeleteValue"} eq 'ARRAY' ) + ? @{ $ARGSRef->{"$prefix-DeleteValue"} } + : ( $ARGSRef->{"$prefix-DeleteValue"} ); + + foreach my $id (@delete_values) { + next unless defined $id; + my ( $err, $msg ) = $Object->DeleteValue($id); + push( @results, $msg ); + } + + my $vals = $Object->Values(); + while ( my $cfv = $vals->Next() ) { + if ( my $so = $ARGSRef->{ "$prefix-SortOrder" . $cfv->Id } ) { + if ( $cfv->SortOrder != $so ) { + my ( $err, $msg ) = $cfv->SetSortOrder($so); + push( @results, $msg ); + } + } + } + + return (@results); +} + + + +=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketBasics { + + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $TicketObj = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my $OrigOwner = $TicketObj->Owner; + + # Set basic fields + my @attribs = qw( + Subject + FinalPriority + Priority + TimeEstimated + TimeWorked + TimeLeft + Type + Status + Queue + ); + + # Canonicalize Queue and Owner to their IDs if they aren't numeric + for my $field (qw(Queue Owner)) { + if ( $ARGSRef->{$field} and ( $ARGSRef->{$field} !~ /^(\d+)$/ ) ) { + my $class = $field eq 'Owner' ? "RT::User" : "RT::$field"; + my $temp = $class->new(RT->SystemUser); + $temp->Load( $ARGSRef->{$field} ); + if ( $temp->id ) { + $ARGSRef->{$field} = $temp->id; + } + } + } + + # Status isn't a field that can be set to a null value. + # RT core complains if you try + delete $ARGSRef->{'Status'} unless $ARGSRef->{'Status'}; + + my @results = UpdateRecordObject( + AttributesRef => \@attribs, + Object => $TicketObj, + ARGSRef => $ARGSRef, + ); + + # We special case owner changing, so we can use ForceOwnerChange + if ( $ARGSRef->{'Owner'} + && $ARGSRef->{'Owner'} !~ /\D/ + && ( $OrigOwner != $ARGSRef->{'Owner'} ) ) { + my ($ChownType); + if ( $ARGSRef->{'ForceOwnerChange'} ) { + $ChownType = "Force"; + } + else { + $ChownType = "Set"; + } + + my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType ); + push( @results, $msg ); + } + + # }}} + + return (@results); +} + +sub ProcessTicketReminders { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $Ticket = $args{'TicketObj'}; + my $args = $args{'ARGSRef'}; + my @results; + + my $reminder_collection = $Ticket->Reminders->Collection; + + if ( $args->{'update-reminders'} ) { + while ( my $reminder = $reminder_collection->Next ) { + my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve; + if ( $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) { + my ($status, $msg) = $Ticket->Reminders->Resolve($reminder); + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + + } + elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) { + my ($status, $msg) = $Ticket->Reminders->Open($reminder); + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + } + + if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) { + my ($status, $msg) = $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ; + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + } + + if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) { + my ($status, $msg) = $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ; + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + } + + if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) { + my $DateObj = RT::Date->new( $session{'CurrentUser'} ); + $DateObj->Set( + Format => 'unknown', + Value => $args->{ 'Reminder-Due-' . $reminder->id } + ); + if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) { + my ($status, $msg) = $reminder->SetDue( $DateObj->ISO ); + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + } + } + } + } + + if ( $args->{'NewReminder-Subject'} ) { + my $due_obj = RT::Date->new( $session{'CurrentUser'} ); + $due_obj->Set( + Format => 'unknown', + Value => $args->{'NewReminder-Due'} + ); + my ( $add_id, $msg ) = $Ticket->Reminders->Add( + Subject => $args->{'NewReminder-Subject'}, + Owner => $args->{'NewReminder-Owner'}, + Due => $due_obj->ISO + ); + if ( $add_id ) { + push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); + } + else { + push @results, $msg; + } + } + return @results; +} + +sub ProcessTicketCustomFieldUpdates { + my %args = @_; + $args{'Object'} = delete $args{'TicketObj'}; + my $ARGSRef = { %{ $args{'ARGSRef'} } }; + + # Build up a list of objects that we want to work with + my %custom_fields_to_mod; + foreach my $arg ( keys %$ARGSRef ) { + if ( $arg =~ /^Ticket-(\d+-.*)/ ) { + $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg}; + } elsif ( $arg =~ /^CustomField-(\d+-.*)/ ) { + $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg}; + } elsif ( $arg =~ /^Object-RT::Transaction-(\d*)-CustomField/ ) { + delete $ARGSRef->{$arg}; # don't try to update transaction fields + } + } + + return ProcessObjectCustomFieldUpdates( %args, ARGSRef => $ARGSRef ); +} + +sub ProcessObjectCustomFieldUpdates { + my %args = @_; + my $ARGSRef = $args{'ARGSRef'}; + my @results; + + # Build up a list of objects that we want to work with + my %custom_fields_to_mod; + foreach my $arg ( keys %$ARGSRef ) { + + # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands> + next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/; + + # For each of those objects, find out what custom fields we want to work with. + $custom_fields_to_mod{$1}{ $2 || 0 }{$3}{$4} = $ARGSRef->{$arg}; + } + + # For each of those objects + foreach my $class ( keys %custom_fields_to_mod ) { + foreach my $id ( keys %{ $custom_fields_to_mod{$class} } ) { + my $Object = $args{'Object'}; + $Object = $class->new( $session{'CurrentUser'} ) + unless $Object && ref $Object eq $class; + + $Object->Load($id) unless ( $Object->id || 0 ) == $id; + unless ( $Object->id ) { + $RT::Logger->warning("Couldn't load object $class #$id"); + next; + } + + foreach my $cf ( keys %{ $custom_fields_to_mod{$class}{$id} } ) { + my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} ); + $CustomFieldObj->SetContextObject($Object); + $CustomFieldObj->LoadById($cf); + unless ( $CustomFieldObj->id ) { + $RT::Logger->warning("Couldn't load custom field #$cf"); + next; + } + push @results, + _ProcessObjectCustomFieldUpdates( + Prefix => "Object-$class-$id-CustomField-$cf-", + Object => $Object, + CustomField => $CustomFieldObj, + ARGS => $custom_fields_to_mod{$class}{$id}{$cf}, + ); + } + } + } + return @results; +} + +sub _ProcessObjectCustomFieldUpdates { + my %args = @_; + my $cf = $args{'CustomField'}; + my $cf_type = $cf->Type || ''; + + # Remove blank Values since the magic field will take care of this. Sometimes + # the browser gives you a blank value which causes CFs to be processed twice + if ( defined $args{'ARGS'}->{'Values'} + && !length $args{'ARGS'}->{'Values'} + && $args{'ARGS'}->{'Values-Magic'} ) + { + delete $args{'ARGS'}->{'Values'}; + } + + my @results; + foreach my $arg ( keys %{ $args{'ARGS'} } ) { + + # skip category argument + next if $arg eq 'Category'; + + # and TimeUnits + next if $arg eq 'Value-TimeUnits'; + + # since http won't pass in a form element with a null value, we need + # to fake it + if ( $arg eq 'Values-Magic' ) { + + # We don't care about the magic, if there's really a values element; + next if defined $args{'ARGS'}->{'Value'} && length $args{'ARGS'}->{'Value'}; + next if defined $args{'ARGS'}->{'Values'} && length $args{'ARGS'}->{'Values'}; + + # "Empty" values does not mean anything for Image and Binary fields + next if $cf_type =~ /^(?:Image|Binary)$/; + + $arg = 'Values'; + $args{'ARGS'}->{'Values'} = undef; + } + + my @values = (); + if ( ref $args{'ARGS'}->{$arg} eq 'ARRAY' ) { + @values = @{ $args{'ARGS'}->{$arg} }; + } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext + @values = ( $args{'ARGS'}->{$arg} ); + } else { + @values = split /\r*\n/, $args{'ARGS'}->{$arg} + if defined $args{'ARGS'}->{$arg}; + } + @values = grep length, map { + s/\r+\n/\n/g; + s/^\s+//; + s/\s+$//; + $_; + } + grep defined, @values; + + if ( $arg eq 'AddValue' || $arg eq 'Value' ) { + foreach my $value (@values) { + my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( + Field => $cf->id, + Value => $value + ); + push( @results, $msg ); + } + } elsif ( $arg eq 'Upload' ) { + my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next; + my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( %$value_hash, Field => $cf, ); + push( @results, $msg ); + } elsif ( $arg eq 'DeleteValues' ) { + foreach my $value (@values) { + my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue( + Field => $cf, + Value => $value, + ); + push( @results, $msg ); + } + } elsif ( $arg eq 'DeleteValueIds' ) { + foreach my $value (@values) { + my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue( + Field => $cf, + ValueId => $value, + ); + push( @results, $msg ); + } + } elsif ( $arg eq 'Values' && !$cf->Repeated ) { + my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id ); + + my %values_hash; + foreach my $value (@values) { + if ( my $entry = $cf_values->HasEntry($value) ) { + $values_hash{ $entry->id } = 1; + next; + } + + my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( + Field => $cf, + Value => $value + ); + push( @results, $msg ); + $values_hash{$val} = 1 if $val; + } + + # For Date Cfs, @values is empty when there is no changes (no datas in form input) + return @results if ( $cf->Type eq 'Date' && ! @values ); + + # For Date Cfs, @values is empty when there is no changes (no datas in form input) + return @results if ( $cf->Type =~ /^Date(?:Time)?$/ && ! @values ); + + $cf_values->RedoSearch; + while ( my $cf_value = $cf_values->Next ) { + next if $values_hash{ $cf_value->id }; + + my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue( + Field => $cf, + ValueId => $cf_value->id + ); + push( @results, $msg ); + } + } elsif ( $arg eq 'Values' ) { + my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id ); + + # keep everything up to the point of difference, delete the rest + my $delete_flag; + foreach my $old_cf ( @{ $cf_values->ItemsArrayRef } ) { + if ( !$delete_flag and @values and $old_cf->Content eq $values[0] ) { + shift @values; + next; + } + + $delete_flag ||= 1; + $old_cf->Delete; + } + + # now add/replace extra things, if any + foreach my $value (@values) { + my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( + Field => $cf, + Value => $value + ); + push( @results, $msg ); + } + } else { + push( + @results, + loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]", + $cf->Name, ref $args{'Object'}, + $args{'Object'}->id + ) + ); + } + } + return @results; +} + + +=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketWatchers { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + my (@results); + + my $Ticket = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + # Munge watchers + + foreach my $key ( keys %$ARGSRef ) { + + # Delete deletable watchers + if ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) { + my ( $code, $msg ) = $Ticket->DeleteWatcher( + PrincipalId => $2, + Type => $1 + ); + push @results, $msg; + } + + # Delete watchers in the simple style demanded by the bulk manipulator + elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) { + my ( $code, $msg ) = $Ticket->DeleteWatcher( + Email => $ARGSRef->{$key}, + Type => $1 + ); + push @results, $msg; + } + + # Add new wathchers by email address + elsif ( ( $ARGSRef->{$key} || '' ) =~ /^(?:AdminCc|Cc|Requestor)$/ + and $key =~ /^WatcherTypeEmail(\d*)$/ ) + { + + #They're in this order because otherwise $1 gets clobbered :/ + my ( $code, $msg ) = $Ticket->AddWatcher( + Type => $ARGSRef->{$key}, + Email => $ARGSRef->{ "WatcherAddressEmail" . $1 } + ); + push @results, $msg; + } + + #Add requestors in the simple style demanded by the bulk manipulator + elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) { + my ( $code, $msg ) = $Ticket->AddWatcher( + Type => $1, + Email => $ARGSRef->{$key} + ); + push @results, $msg; + } + + # Add new watchers by owner + elsif ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) { + my $principal_id = $1; + my $form = $ARGSRef->{$key}; + foreach my $value ( ref($form) ? @{$form} : ($form) ) { + next unless $value =~ /^(?:AdminCc|Cc|Requestor)$/i; + + my ( $code, $msg ) = $Ticket->AddWatcher( + Type => $value, + PrincipalId => $principal_id + ); + push @results, $msg; + } + } + + } + return (@results); +} + + + +=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketDates { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $Ticket = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my (@results); + + # Set date fields + my @date_fields = qw( + Told + Resolved + Starts + Started + Due + WillResolve + ); + + #Run through each field in this list. update the value if apropriate + foreach my $field (@date_fields) { + next unless exists $ARGSRef->{ $field . '_Date' }; + next if $ARGSRef->{ $field . '_Date' } eq ''; + + my ( $code, $msg ); + + my $DateObj = RT::Date->new( $session{'CurrentUser'} ); + $DateObj->Set( + Format => 'unknown', + Value => $ARGSRef->{ $field . '_Date' } + ); + + my $obj = $field . "Obj"; + if ( ( defined $DateObj->Unix ) + and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) ) + { + my $method = "Set$field"; + my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO ); + push @results, "$msg"; + } + } + + # }}} + return (@results); +} + + + +=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketLinks { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $Ticket = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my (@results) = ProcessRecordLinks( RecordObj => $Ticket, ARGSRef => $ARGSRef ); + + #Merge if we need to + if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) { + $ARGSRef->{ $Ticket->Id . "-MergeInto" } =~ s/\s+//g; + my ( $val, $msg ) = $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ); + push @results, $msg; + } + + return (@results); +} + + +sub ProcessRecordLinks { + my %args = ( + RecordObj => undef, + ARGSRef => undef, + @_ + ); + + my $Record = $args{'RecordObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my (@results); + + # Delete links that are gone gone gone. + foreach my $arg ( keys %$ARGSRef ) { + if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) { + my $base = $1; + my $type = $2; + my $target = $3; + + my ( $val, $msg ) = $Record->DeleteLink( + Base => $base, + Type => $type, + Target => $target + ); + + push @results, $msg; + + } + + } + + my @linktypes = qw( DependsOn MemberOf RefersTo ); + + foreach my $linktype (@linktypes) { + if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) { + $ARGSRef->{ $Record->Id . "-$linktype" } = join( ' ', @{ $ARGSRef->{ $Record->Id . "-$linktype" } } ) + if ref( $ARGSRef->{ $Record->Id . "-$linktype" } ); + + for my $luri ( split( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) { + next unless $luri; + $luri =~ s/\s+$//; # Strip trailing whitespace + my ( $val, $msg ) = $Record->AddLink( + Target => $luri, + Type => $linktype + ); + push @results, $msg; + } + } + if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) { + $ARGSRef->{ "$linktype-" . $Record->Id } = join( ' ', @{ $ARGSRef->{ "$linktype-" . $Record->Id } } ) + if ref( $ARGSRef->{ "$linktype-" . $Record->Id } ); + + for my $luri ( split( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) { + next unless $luri; + my ( $val, $msg ) = $Record->AddLink( + Base => $luri, + Type => $linktype + ); + + push @results, $msg; + } + } + } + + return (@results); +} + +=head2 ProcessTransactionSquelching + +Takes a hashref of the submitted form arguments, C<%ARGS>. + +Returns a hash of squelched addresses. + +=cut + +sub ProcessTransactionSquelching { + my $args = shift; + my %checked = map { $_ => 1 } grep { defined } + ( ref $args->{'TxnSendMailTo'} eq "ARRAY" ? @{$args->{'TxnSendMailTo'}} : + defined $args->{'TxnSendMailTo'} ? ($args->{'TxnSendMailTo'}) : + () ); + my %squelched = map { $_ => 1 } grep { not $checked{$_} } split /,/, ($args->{'TxnRecipients'}||''); + return %squelched; +} + +=head2 _UploadedFile ( $arg ); + +Takes a CGI parameter name; if a file is uploaded under that name, +return a hash reference suitable for AddCustomFieldValue's use: +C<( Value => $filename, LargeContent => $content, ContentType => $type )>. + +Returns C<undef> if no files were uploaded in the C<$arg> field. + +=cut + +sub _UploadedFile { + my $arg = shift; + my $cgi_object = $m->cgi_object; + my $fh = $cgi_object->upload($arg) or return undef; + my $upload_info = $cgi_object->uploadInfo($fh); + + my $filename = "$fh"; + $filename =~ s#^.*[\\/]##; + binmode($fh); + + return { + Value => $filename, + LargeContent => do { local $/; scalar <$fh> }, + ContentType => $upload_info->{'Content-Type'}, + }; +} + +sub GetColumnMapEntry { + my %args = ( Map => {}, Name => '', Attribute => undef, @_ ); + + # deal with the simplest thing first + if ( $args{'Map'}{ $args{'Name'} } ) { + return $args{'Map'}{ $args{'Name'} }{ $args{'Attribute'} }; + } + + # complex things + elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.(.+)$/ ) { + $subkey =~ s/^\{(.*)\}$/$1/; + return undef unless $args{'Map'}->{$mainkey}; + return $args{'Map'}{$mainkey}{ $args{'Attribute'} } + unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE'; + + return sub { $args{'Map'}{$mainkey}{ $args{'Attribute'} }->( @_, $subkey ) }; + } + return undef; +} + +sub ProcessColumnMapValue { + my $value = shift; + my %args = ( Arguments => [], Escape => 1, @_ ); + + if ( ref $value ) { + if ( UNIVERSAL::isa( $value, 'CODE' ) ) { + my @tmp = $value->( @{ $args{'Arguments'} } ); + return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args ); + } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) { + return join '', map ProcessColumnMapValue( $_, %args ), @$value; + } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) { + return $$value; + } + } + + return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'}; + return $value; +} + +=head2 GetPrincipalsMap OBJECT, CATEGORIES + +Returns an array suitable for passing to /Admin/Elements/EditRights with the +principal collections mapped from the categories given. + +=cut + +sub GetPrincipalsMap { + my $object = shift; + my @map; + for (@_) { + if (/System/) { + my $system = RT::Groups->new($session{'CurrentUser'}); + $system->LimitToSystemInternalGroups(); + $system->OrderBy( FIELD => 'Type', ORDER => 'ASC' ); + push @map, [ + 'System' => $system, # loc_left_pair + 'Type' => 1, + ]; + } + elsif (/Groups/) { + my $groups = RT::Groups->new($session{'CurrentUser'}); + $groups->LimitToUserDefinedGroups(); + $groups->OrderBy( FIELD => 'Name', ORDER => 'ASC' ); + + # Only show groups who have rights granted on this object + $groups->WithGroupRight( + Right => '', + Object => $object, + IncludeSystemRights => 0, + IncludeSubgroupMembers => 0, + ); + + push @map, [ + 'User Groups' => $groups, # loc_left_pair + 'Name' => 0 + ]; + } + elsif (/Roles/) { + my $roles = RT::Groups->new($session{'CurrentUser'}); + + if ($object->isa('RT::System')) { + $roles->LimitToRolesForSystem(); + } + elsif ($object->isa('RT::Queue')) { + $roles->LimitToRolesForQueue($object->Id); + } + else { + $RT::Logger->warn("Skipping unknown object type ($object) for Role principals"); + next; + } + $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' ); + push @map, [ + 'Roles' => $roles, # loc_left_pair + 'Type' => 1 + ]; + } + elsif (/Users/) { + my $Users = RT->PrivilegedUsers->UserMembersObj(); + $Users->OrderBy( FIELD => 'Name', ORDER => 'ASC' ); + + # Only show users who have rights granted on this object + my $group_members = $Users->WhoHaveGroupRight( + Right => '', + Object => $object, + IncludeSystemRights => 0, + IncludeSubgroupMembers => 0, + ); + + # Limit to UserEquiv groups + my $groups = $Users->NewAlias('Groups'); + $Users->Join( + ALIAS1 => $groups, + FIELD1 => 'id', + ALIAS2 => $group_members, + FIELD2 => 'GroupId' + ); + $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence' ); + $Users->Limit( ALIAS => $groups, FIELD => 'Type', VALUE => 'UserEquiv' ); + + + my $display = sub { + $m->scomp('/Elements/ShowUser', User => $_[0], NoEscape => 1) + }; + push @map, [ + 'Users' => $Users, # loc_left_pair + $display => 0 + ]; + } + } + return @map; +} + +=head2 _load_container_object ( $type, $id ); + +Instantiate container object for saving searches. + +=cut + +sub _load_container_object { + my ( $obj_type, $obj_id ) = @_; + return RT::SavedSearch->new( $session{'CurrentUser'} )->_load_privacy_object( $obj_type, $obj_id ); +} + +=head2 _parse_saved_search ( $arg ); + +Given a serialization string for saved search, and returns the +container object and the search id. + +=cut + +sub _parse_saved_search { + my $spec = shift; + return unless $spec; + if ( $spec !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) { + return; + } + my $obj_type = $1; + my $obj_id = $2; + my $search_id = $3; + + return ( _load_container_object( $obj_type, $obj_id ), $search_id ); +} + +=head2 ScrubHTML content + +Removes unsafe and undesired HTML from the passed content + +=cut + +my $SCRUBBER; +sub ScrubHTML { + my $Content = shift; + $SCRUBBER = _NewScrubber() unless $SCRUBBER; + + $Content = '' if !defined($Content); + return $SCRUBBER->scrub($Content); +} + +=head2 _NewScrubber + +Returns a new L<HTML::Scrubber> object. + +If you need to be more lax about what HTML tags and attributes are allowed, +create C</opt/rt4/local/lib/RT/Interface/Web_Local.pm> with something like the +following: + + package HTML::Mason::Commands; + # Let tables through + push @SCRUBBER_ALLOWED_TAGS, qw(TABLE THEAD TBODY TFOOT TR TD TH); + 1; + +=cut + +our @SCRUBBER_ALLOWED_TAGS = qw( + A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP STRIKE H1 H2 H3 H4 H5 + H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO +); + +our %SCRUBBER_ALLOWED_ATTRIBUTES = ( + # Match http, https, ftp, mailto and relative urls + # XXX: we also scrub format strings with this module then allow simple config options + href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i, + face => 1, + size => 1, + target => 1, + style => qr{ + ^(?:\s* + (?:(?:background-)?color: \s* + (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) | # rgb(d,d,d) + \#[a-f0-9]{3,6} | # #fff or #ffffff + [\w\-]+ # green, light-blue, etc. + ) | + text-align: \s* \w+ | + font-size: \s* [\w.\-]+ | + font-family: \s* [\w\s"',.\-]+ | + font-weight: \s* [\w\-]+ | + + # MS Office styles, which are probably fine. If we don't, then any + # associated styles in the same attribute get stripped. + mso-[\w\-]+?: \s* [\w\s"',.\-]+ + )\s* ;? \s*) + +$ # one or more of these allowed properties from here 'till sunset + }ix, + dir => qr/^(rtl|ltr)$/i, + lang => qr/^\w+(-\w+)?$/, +); + +our %SCRUBBER_RULES = (); + +sub _NewScrubber { + require HTML::Scrubber; + my $scrubber = HTML::Scrubber->new(); + $scrubber->default( + 0, + { + %SCRUBBER_ALLOWED_ATTRIBUTES, + '*' => 0, # require attributes be explicitly allowed + }, + ); + $scrubber->deny(qw[*]); + $scrubber->allow(@SCRUBBER_ALLOWED_TAGS); + $scrubber->rules(%SCRUBBER_RULES); + + # Scrubbing comments is vital since IE conditional comments can contain + # arbitrary HTML and we'd pass it right on through. + $scrubber->comment(0); + + return $scrubber; +} + +=head2 JSON + +Redispatches to L<RT::Interface::Web/EncodeJSON> + +=cut + +sub JSON { + RT::Interface::Web::EncodeJSON(@_); +} + +package RT::Interface::Web; +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm index 07e770724..7cf18d1ab 100644 --- a/rt/lib/RT/Interface/Web/Handler.pm +++ b/rt/lib/RT/Interface/Web/Handler.pm @@ -251,7 +251,6 @@ use CGI::Emulate::PSGI; use Plack::Request; use Plack::Response; use Plack::Util; -use Encode qw(encode_utf8); sub PSGIApp { my $self = shift; @@ -328,7 +327,10 @@ sub _psgi_response_cb { $cleanup->(); return ''; } - return utf8::is_utf8($_[0]) ? encode_utf8($_[0]) : $_[0]; + # XXX: Ideally, responses should flag if they need + # to be encoded, rather than relying on the UTF-8 + # flag + return Encode::encode("UTF-8",$_[0]) if utf8::is_utf8($_[0]); return $_[0]; }; }); diff --git a/rt/lib/RT/ObjectCustomFieldValue.pm b/rt/lib/RT/ObjectCustomFieldValue.pm index 0e63ced1b..af740e967 100644 --- a/rt/lib/RT/ObjectCustomFieldValue.pm +++ b/rt/lib/RT/ObjectCustomFieldValue.pm @@ -90,7 +90,8 @@ sub Create { my ($val, $msg) = $cf->_CanonicalizeValue(\%args); return ($val, $msg) unless $val; - if ( defined $args{'Content'} && length( Encode::encode_utf8($args{'Content'}) ) > 255 ) { + my $encoded = Encode::encode("UTF-8", $args{'Content'}); + if ( defined $args{'Content'} && length( $encoded ) > 255 ) { if ( defined $args{'LargeContent'} && length $args{'LargeContent'} ) { $RT::Logger->error("Content is longer than 255 bytes and LargeContent specified"); } diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index 7adfc2678..1cc63ec7f 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -71,7 +71,6 @@ use RT::Date; use RT::I18N; use RT::User; use RT::Attributes; -use Encode qw(); our $_TABLE_ATTR = { }; use base RT->Config->Get('RecordBaseClass'); @@ -646,12 +645,16 @@ sub __Value { return undef if (!defined $value); + # Pg returns character columns as character strings; mysql and + # sqlite return them as bytes. While mysql can be made to return + # characters, using the mysql_enable_utf8 flag, the "Content" column + # is bytes on mysql and characters on Postgres, making true + # consistency impossible. if ( $args{'decode_utf8'} ) { - if ( !utf8::is_utf8($value) ) { + if ( !utf8::is_utf8($value) ) { # mysql/sqlite utf8::decode($value); } - } - else { + } else { if ( utf8::is_utf8($value) ) { utf8::encode($value); } @@ -748,75 +751,72 @@ evaluate and encode it. It will return an octet string. =cut sub _EncodeLOB { - my $self = shift; - my $Body = shift; - my $MIMEType = shift || ''; - my $Filename = shift; - - my $ContentEncoding = 'none'; + my $self = shift; + my $Body = shift; + my $MIMEType = shift || ''; + my $Filename = shift; - #get the max attachment length from RT - my $MaxSize = RT->Config->Get('MaxAttachmentSize'); + my $ContentEncoding = 'none'; - #if the current attachment contains nulls and the - #database doesn't support embedded nulls + RT::Util::assert_bytes( $Body ); - if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { + #get the max attachment length from RT + my $MaxSize = RT->Config->Get('MaxAttachmentSize'); - # set a flag telling us to mimencode the attachment - $ContentEncoding = 'base64'; + #if the current attachment contains nulls and the + #database doesn't support embedded nulls - #cut the max attchment size by 25% (for mime-encoding overhead. - $RT::Logger->debug("Max size is $MaxSize"); - $MaxSize = $MaxSize * 3 / 4; - # Some databases (postgres) can't handle non-utf8 data - } elsif ( !$RT::Handle->BinarySafeBLOBs - && $Body =~ /\P{ASCII}/ - && !Encode::is_utf8( $Body, 1 ) ) { - $ContentEncoding = 'quoted-printable'; - } + if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { - #if the attachment is larger than the maximum size - if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { + # set a flag telling us to mimencode the attachment + $ContentEncoding = 'base64'; - # if we're supposed to truncate large attachments - if (RT->Config->Get('TruncateLongAttachments')) { + #cut the max attchment size by 25% (for mime-encoding overhead. + $RT::Logger->debug("Max size is $MaxSize"); + $MaxSize = $MaxSize * 3 / 4; + # Some databases (postgres) can't handle non-utf8 data + } elsif ( !$RT::Handle->BinarySafeBLOBs + && $Body =~ /\P{ASCII}/ + && !Encode::is_utf8( $Body, 1 ) ) { + $ContentEncoding = 'quoted-printable'; + } - # truncate the attachment to that length. - $Body = substr( $Body, 0, $MaxSize ); + #if the attachment is larger than the maximum size + if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { - } + # if we're supposed to truncate large attachments + if (RT->Config->Get('TruncateLongAttachments')) { - # elsif we're supposed to drop large attachments on the floor, - elsif (RT->Config->Get('DropLongAttachments')) { + # truncate the attachment to that length. + $Body = substr( $Body, 0, $MaxSize ); - # drop the attachment on the floor - $RT::Logger->info( "$self: Dropped an attachment of size " - . length($Body)); - $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); - $Filename .= ".txt" if $Filename; - return ("none", "Large attachment dropped", "text/plain", $Filename ); - } } - # if we need to mimencode the attachment - if ( $ContentEncoding eq 'base64' ) { - - # base64 encode the attachment - Encode::_utf8_off($Body); - $Body = MIME::Base64::encode_base64($Body); + # elsif we're supposed to drop large attachments on the floor, + elsif (RT->Config->Get('DropLongAttachments')) { - } elsif ($ContentEncoding eq 'quoted-printable') { - Encode::_utf8_off($Body); - $Body = MIME::QuotedPrint::encode($Body); + # drop the attachment on the floor + $RT::Logger->info( "$self: Dropped an attachment of size " + . length($Body)); + $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); + $Filename .= ".txt" if $Filename; + return ("none", "Large attachment dropped", "text/plain", $Filename ); } + } + # if we need to mimencode the attachment + if ( $ContentEncoding eq 'base64' ) { + # base64 encode the attachment + $Body = MIME::Base64::encode_base64($Body); - return ($ContentEncoding, $Body, $MIMEType, $Filename ); + } elsif ($ContentEncoding eq 'quoted-printable') { + $Body = MIME::QuotedPrint::encode($Body); + } + return ($ContentEncoding, $Body, $MIMEType, $Filename ); } -=head2 _DecodeLOB +=head2 _DecodeLOB C<ContentType>, C<ContentEncoding>, C<Content> Unpacks data stored in the database, which may be base64 or QP encoded because of our need to store binary and badly encoded data in columns @@ -832,6 +832,12 @@ This is similar to how we filter all data coming in via the web UI in RT::Interface::Web::DecodeARGS. This filter should only end up being applied to old data from less UTF-8-safe versions of RT. +If the passed C<ContentType> includes a character set, that will be used +to decode textual data; the default character set is UTF-8. This is +necessary because while we attempt to store textual data as UTF-8, the +definition of "textual" has migrated over time, and thus we may now need +to attempt to decode data that was previously not trancoded on insertion. + Important Note - This function expects an octet string and returns a character string for non-binary data. @@ -843,6 +849,8 @@ sub _DecodeLOB { my $ContentEncoding = shift || 'none'; my $Content = shift; + RT::Util::assert_bytes( $Content ); + if ( $ContentEncoding eq 'base64' ) { $Content = MIME::Base64::decode_base64($Content); } @@ -853,9 +861,15 @@ sub _DecodeLOB { return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) ); } if ( RT::I18N::IsTextualContentType($ContentType) ) { - $Content = Encode::decode('UTF-8',$Content,Encode::FB_PERLQQ) unless Encode::is_utf8($Content); + my $entity = MIME::Entity->new(); + $entity->head->add("Content-Type", $ContentType); + $entity->bodyhandle( MIME::Body::Scalar->new( $Content ) ); + my $charset = RT::I18N::_FindOrGuessCharset($entity); + $charset = 'utf-8' if not $charset or not Encode::find_encoding($charset); + + $Content = Encode::decode($charset,$Content,Encode::FB_PERLQQ); } - return ($Content); + return ($Content); } # A helper table for links mapping to make it easier diff --git a/rt/lib/RT/Record.pm.orig b/rt/lib/RT/Record.pm.orig new file mode 100755 index 000000000..7adfc2678 --- /dev/null +++ b/rt/lib/RT/Record.pm.orig @@ -0,0 +1,2102 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +=head1 NAME + + RT::Record - Base class for RT record objects + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + + +=head1 METHODS + +=cut + +package RT::Record; + +use strict; +use warnings; + + +use RT::Date; +use RT::I18N; +use RT::User; +use RT::Attributes; +use Encode qw(); + +our $_TABLE_ATTR = { }; +use base RT->Config->Get('RecordBaseClass'); +use base 'RT::Base'; + + +sub _Init { + my $self = shift; + $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)}); + $self->CurrentUser(@_); +} + + + +=head2 _PrimaryKeys + +The primary keys for RT classes is 'id' + +=cut + +sub _PrimaryKeys { return ['id'] } +# short circuit many, many thousands of calls from searchbuilder +sub _PrimaryKey { 'id' } + +=head2 Id + +Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do +on a very common codepath + +C<id> is an alias to C<Id> and is the preferred way to call this method. + +=cut + +sub Id { + return shift->{'values'}->{id}; +} + +*id = \&Id; + +=head2 Delete + +Delete this record object from the database. + +=cut + +sub Delete { + my $self = shift; + my ($rv) = $self->SUPER::Delete; + if ($rv) { + return ($rv, $self->loc("Object deleted")); + } else { + + return(0, $self->loc("Object could not be deleted")) + } +} + +=head2 ObjectTypeStr + +Returns a string which is this object's type. The type is the class, +without the "RT::" prefix. + + +=cut + +sub ObjectTypeStr { + my $self = shift; + if (ref($self) =~ /^.*::(\w+)$/) { + return $self->loc($1); + } else { + return $self->loc(ref($self)); + } +} + +=head2 Attributes + +Return this object's attributes as an RT::Attributes object + +=cut + +sub Attributes { + my $self = shift; + unless ($self->{'attributes'}) { + $self->{'attributes'} = RT::Attributes->new($self->CurrentUser); + $self->{'attributes'}->LimitToObject($self); + $self->{'attributes'}->OrderByCols({FIELD => 'id'}); + } + return ($self->{'attributes'}); +} + + +=head2 AddAttribute { Name, Description, Content } + +Adds a new attribute for this object. + +=cut + +sub AddAttribute { + my $self = shift; + my %args = ( Name => undef, + Description => undef, + Content => undef, + @_ ); + + my $attr = RT::Attribute->new( $self->CurrentUser ); + my ( $id, $msg ) = $attr->Create( + Object => $self, + Name => $args{'Name'}, + Description => $args{'Description'}, + Content => $args{'Content'} ); + + + # XXX TODO: Why won't RedoSearch work here? + $self->Attributes->_DoSearch; + + return ($id, $msg); +} + + +=head2 SetAttribute { Name, Description, Content } + +Like AddAttribute, but replaces all existing attributes with the same Name. + +=cut + +sub SetAttribute { + my $self = shift; + my %args = ( Name => undef, + Description => undef, + Content => undef, + @_ ); + + my @AttributeObjs = $self->Attributes->Named( $args{'Name'} ) + or return $self->AddAttribute( %args ); + + my $AttributeObj = pop( @AttributeObjs ); + $_->Delete foreach @AttributeObjs; + + $AttributeObj->SetDescription( $args{'Description'} ); + $AttributeObj->SetContent( $args{'Content'} ); + + $self->Attributes->RedoSearch; + return 1; +} + +=head2 DeleteAttribute NAME + +Deletes all attributes with the matching name for this object. + +=cut + +sub DeleteAttribute { + my $self = shift; + my $name = shift; + my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name ); + $self->ClearAttributes; + return ($val,$msg); +} + +=head2 FirstAttribute NAME + +Returns the first attribute with the matching name for this object (as an +L<RT::Attribute> object), or C<undef> if no such attributes exist. +If there is more than one attribute with the matching name on the +object, the first value that was set is returned. + +=cut + +sub FirstAttribute { + my $self = shift; + my $name = shift; + return ($self->Attributes->Named( $name ))[0]; +} + + +sub ClearAttributes { + my $self = shift; + delete $self->{'attributes'}; + +} + +sub _Handle { return $RT::Handle } + + + +=head2 Create PARAMHASH + +Takes a PARAMHASH of Column -> Value pairs. +If any Column has a Validate$PARAMNAME subroutine defined and the +value provided doesn't pass validation, this routine returns +an error. + +If this object's table has any of the following atetributes defined as +'Auto', this routine will automatically fill in their values. + +=over + +=item Created + +=item Creator + +=item LastUpdated + +=item LastUpdatedBy + +=back + +=cut + +sub Create { + my $self = shift; + my %attribs = (@_); + foreach my $key ( keys %attribs ) { + if (my $method = $self->can("Validate$key")) { + if (! $method->( $self, $attribs{$key} ) ) { + if (wantarray) { + return ( 0, $self->loc('Invalid value for [_1]', $key) ); + } + else { + return (0); + } + } + } + } + + + + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime(); + + my $now_iso = + sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec); + + $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'}); + + if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) { + $attribs{'Creator'} = $self->CurrentUser->id || '0'; + } + $attribs{'LastUpdated'} = $now_iso + if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'}); + + $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0' + if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'}); + + my $id = $self->SUPER::Create(%attribs); + if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) { + if ( $id->errno ) { + if (wantarray) { + return ( 0, + $self->loc( "Internal Error: [_1]", $id->{error_message} ) ); + } + else { + return (0); + } + } + } + # If the object was created in the database, + # load it up now, so we're sure we get what the database + # has. Arguably, this should not be necessary, but there + # isn't much we can do about it. + + unless ($id) { + if (wantarray) { + return ( $id, $self->loc('Object could not be created') ); + } + else { + return ($id); + } + + } + + if (UNIVERSAL::isa('errno',$id)) { + return(undef); + } + + $self->Load($id) if ($id); + + + + if (wantarray) { + return ( $id, $self->loc('Object created') ); + } + else { + return ($id); + } + +} + + + +=head2 LoadByCols + +Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the +DB is case sensitive + +=cut + +sub LoadByCols { + my $self = shift; + + # We don't want to hang onto this + $self->ClearAttributes; + + return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive; + + # If this database is case sensitive we need to uncase objects for + # explicit loading + my %hash = (@_); + foreach my $key ( keys %hash ) { + + # If we've been passed an empty value, we can't do the lookup. + # We don't need to explicitly downcase integers or an id. + if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) { + my ($op, $val, $func); + ($key, $op, $val, $func) = + $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } ); + $hash{$key}->{operator} = $op; + $hash{$key}->{value} = $val; + $hash{$key}->{function} = $func; + } + } + return $self->SUPER::LoadByCols( %hash ); +} + + + +# There is room for optimizations in most of those subs: + + +sub LastUpdatedObj { + my $self = shift; + my $obj = RT::Date->new( $self->CurrentUser ); + + $obj->Set( Format => 'sql', Value => $self->LastUpdated ); + return $obj; +} + + + +sub CreatedObj { + my $self = shift; + my $obj = RT::Date->new( $self->CurrentUser ); + + $obj->Set( Format => 'sql', Value => $self->Created ); + + return $obj; +} + + +# +# TODO: This should be deprecated +# +sub AgeAsString { + my $self = shift; + return ( $self->CreatedObj->AgeAsString() ); +} + + + +# TODO this should be deprecated + +sub LastUpdatedAsString { + my $self = shift; + if ( $self->LastUpdated ) { + return ( $self->LastUpdatedObj->AsString() ); + + } + else { + return "never"; + } +} + + +# +# TODO This should be deprecated +# +sub CreatedAsString { + my $self = shift; + return ( $self->CreatedObj->AsString() ); +} + + +# +# TODO This should be deprecated +# +sub LongSinceUpdateAsString { + my $self = shift; + if ( $self->LastUpdated ) { + + return ( $self->LastUpdatedObj->AgeAsString() ); + + } + else { + return "never"; + } +} + + + +# +sub _Set { + my $self = shift; + + my %args = ( + Field => undef, + Value => undef, + IsSQL => undef, + @_ + ); + + #if the user is trying to modify the record + # TODO: document _why_ this code is here + + if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) { + $args{'Value'} = 0; + } + + my $old_val = $self->__Value($args{'Field'}); + $self->_SetLastUpdated(); + my $ret = $self->SUPER::_Set( + Field => $args{'Field'}, + Value => $args{'Value'}, + IsSQL => $args{'IsSQL'} + ); + my ($status, $msg) = $ret->as_array(); + + # @values has two values, a status code and a message. + + # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool + # we want to change the standard "success" message + if ($status) { + if ($self->SQLType( $args{'Field'}) =~ /text/) { + $msg = $self->loc( + "[_1] updated", + $self->loc( $args{'Field'} ), + ); + } else { + $msg = $self->loc( + "[_1] changed from [_2] to [_3]", + $self->loc( $args{'Field'} ), + ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ), + '"' . $self->__Value( $args{'Field'}) . '"', + ); + } + } else { + $msg = $self->CurrentUser->loc_fuzzy($msg); + } + + return wantarray ? ($status, $msg) : $ret; +} + + + +=head2 _SetLastUpdated + +This routine updates the LastUpdated and LastUpdatedBy columns of the row in question +It takes no options. Arguably, this is a bug + +=cut + +sub _SetLastUpdated { + my $self = shift; + use RT::Date; + my $now = RT::Date->new( $self->CurrentUser ); + $now->SetToNow(); + + if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) { + my ( $msg, $val ) = $self->__Set( + Field => 'LastUpdated', + Value => $now->ISO + ); + } + if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) { + my ( $msg, $val ) = $self->__Set( + Field => 'LastUpdatedBy', + Value => $self->CurrentUser->id + ); + } +} + + + +=head2 CreatorObj + +Returns an RT::User object with the RT account of the creator of this row + +=cut + +sub CreatorObj { + my $self = shift; + unless ( exists $self->{'CreatorObj'} ) { + + $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser ); + $self->{'CreatorObj'}->Load( $self->Creator ); + } + return ( $self->{'CreatorObj'} ); +} + + + +=head2 LastUpdatedByObj + + Returns an RT::User object of the last user to touch this object + +=cut + +sub LastUpdatedByObj { + my $self = shift; + unless ( exists $self->{LastUpdatedByObj} ) { + $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser ); + $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy ); + } + return $self->{'LastUpdatedByObj'}; +} + + + +=head2 URI + +Returns this record's URI + +=cut + +sub URI { + my $self = shift; + my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser); + return($uri->URIForObject($self)); +} + + +=head2 ValidateName NAME + +Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name + +=cut + +sub ValidateName { + my $self = shift; + my $value = shift; + if (defined $value && $value=~ /^\d+$/) { + return(0); + } else { + return(1); + } +} + + + +=head2 SQLType attribute + +return the SQL type for the attribute 'attribute' as stored in _ClassAccessible + +=cut + +sub SQLType { + my $self = shift; + my $field = shift; + + return ($self->_Accessible($field, 'type')); + + +} + +sub __Value { + my $self = shift; + my $field = shift; + my %args = ( decode_utf8 => 1, @_ ); + + unless ($field) { + $RT::Logger->error("__Value called with undef field"); + } + + my $value = $self->SUPER::__Value($field); + + return undef if (!defined $value); + + if ( $args{'decode_utf8'} ) { + if ( !utf8::is_utf8($value) ) { + utf8::decode($value); + } + } + else { + if ( utf8::is_utf8($value) ) { + utf8::encode($value); + } + } + + return $value; + +} + +# Set up defaults for DBIx::SearchBuilder::Record::Cachable + +sub _CacheConfig { + { + 'cache_p' => 1, + 'cache_for_sec' => 30, + } +} + + + +sub _BuildTableAttributes { + my $self = shift; + my $class = ref($self) || $self; + + my $attributes; + if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) { + $attributes = $self->_CoreAccessible(); + } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) { + $attributes = $self->_ClassAccessible(); + + } + + foreach my $column (keys %$attributes) { + foreach my $attr ( keys %{ $attributes->{$column} } ) { + $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; + } + } + foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) { + next unless UNIVERSAL::can( $self, $method ); + $attributes = $self->$method(); + + foreach my $column ( keys %$attributes ) { + foreach my $attr ( keys %{ $attributes->{$column} } ) { + $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; + } + } + } +} + + +=head2 _ClassAccessible + +Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in +DBIx::SearchBuilder::Record + +=cut + +sub _ClassAccessible { + my $self = shift; + return $_TABLE_ATTR->{ref($self) || $self}; +} + +=head2 _Accessible COLUMN ATTRIBUTE + +returns the value of ATTRIBUTE for COLUMN + + +=cut + +sub _Accessible { + my $self = shift; + my $column = shift; + my $attribute = lc(shift); + return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column}); + return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0; + +} + +=head2 _EncodeLOB BODY MIME_TYPE FILENAME + +Takes a potentially large attachment. Returns (ContentEncoding, +EncodedBody, MimeType, Filename) based on system configuration and +selected database. Returns a custom (short) text/plain message if +DropLongAttachments causes an attachment to not be stored. + +Encodes your data as base64 or Quoted-Printable as needed based on your +Databases's restrictions and the UTF-8ness of the data being passed in. Since +we are storing in columns marked UTF8, we must ensure that binary data is +encoded on databases which are strict. + +This function expects to receive an octet string in order to properly +evaluate and encode it. It will return an octet string. + +=cut + +sub _EncodeLOB { + my $self = shift; + my $Body = shift; + my $MIMEType = shift || ''; + my $Filename = shift; + + my $ContentEncoding = 'none'; + + #get the max attachment length from RT + my $MaxSize = RT->Config->Get('MaxAttachmentSize'); + + #if the current attachment contains nulls and the + #database doesn't support embedded nulls + + if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { + + # set a flag telling us to mimencode the attachment + $ContentEncoding = 'base64'; + + #cut the max attchment size by 25% (for mime-encoding overhead. + $RT::Logger->debug("Max size is $MaxSize"); + $MaxSize = $MaxSize * 3 / 4; + # Some databases (postgres) can't handle non-utf8 data + } elsif ( !$RT::Handle->BinarySafeBLOBs + && $Body =~ /\P{ASCII}/ + && !Encode::is_utf8( $Body, 1 ) ) { + $ContentEncoding = 'quoted-printable'; + } + + #if the attachment is larger than the maximum size + if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { + + # if we're supposed to truncate large attachments + if (RT->Config->Get('TruncateLongAttachments')) { + + # truncate the attachment to that length. + $Body = substr( $Body, 0, $MaxSize ); + + } + + # elsif we're supposed to drop large attachments on the floor, + elsif (RT->Config->Get('DropLongAttachments')) { + + # drop the attachment on the floor + $RT::Logger->info( "$self: Dropped an attachment of size " + . length($Body)); + $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); + $Filename .= ".txt" if $Filename; + return ("none", "Large attachment dropped", "text/plain", $Filename ); + } + } + + # if we need to mimencode the attachment + if ( $ContentEncoding eq 'base64' ) { + + # base64 encode the attachment + Encode::_utf8_off($Body); + $Body = MIME::Base64::encode_base64($Body); + + } elsif ($ContentEncoding eq 'quoted-printable') { + Encode::_utf8_off($Body); + $Body = MIME::QuotedPrint::encode($Body); + } + + + return ($ContentEncoding, $Body, $MIMEType, $Filename ); + +} + +=head2 _DecodeLOB + +Unpacks data stored in the database, which may be base64 or QP encoded +because of our need to store binary and badly encoded data in columns +marked as UTF-8. Databases such as PostgreSQL and Oracle care that you +are feeding them invalid UTF-8 and will refuse the content. This +function handles unpacking the encoded data. + +It returns textual data as a UTF-8 string which has been processed by Encode's +PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see +the invalid byte but won't run into problems treating the data as UTF-8 later. + +This is similar to how we filter all data coming in via the web UI in +RT::Interface::Web::DecodeARGS. This filter should only end up being +applied to old data from less UTF-8-safe versions of RT. + +Important Note - This function expects an octet string and returns a +character string for non-binary data. + +=cut + +sub _DecodeLOB { + my $self = shift; + my $ContentType = shift || ''; + my $ContentEncoding = shift || 'none'; + my $Content = shift; + + if ( $ContentEncoding eq 'base64' ) { + $Content = MIME::Base64::decode_base64($Content); + } + elsif ( $ContentEncoding eq 'quoted-printable' ) { + $Content = MIME::QuotedPrint::decode($Content); + } + elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) { + return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) ); + } + if ( RT::I18N::IsTextualContentType($ContentType) ) { + $Content = Encode::decode('UTF-8',$Content,Encode::FB_PERLQQ) unless Encode::is_utf8($Content); + } + return ($Content); +} + +# A helper table for links mapping to make it easier +# to build and parse links between tickets + +use vars '%LINKDIRMAP'; + +%LINKDIRMAP = ( + MemberOf => { Base => 'MemberOf', + Target => 'HasMember', }, + RefersTo => { Base => 'RefersTo', + Target => 'ReferredToBy', }, + DependsOn => { Base => 'DependsOn', + Target => 'DependedOnBy', }, + MergedInto => { Base => 'MergedInto', + Target => 'MergedInto', }, + +); + +=head2 Update ARGSHASH + +Updates fields on an object for you using the proper Set methods, +skipping unchanged values. + + ARGSRef => a hashref of attributes => value for the update + AttributesRef => an arrayref of keys in ARGSRef that should be updated + AttributePrefix => a prefix that should be added to the attributes in AttributesRef + when looking up values in ARGSRef + Bare attributes are tried before prefixed attributes + +Returns a list of localized results of the update + +=cut + +sub Update { + my $self = shift; + + my %args = ( + ARGSRef => undef, + AttributesRef => undef, + AttributePrefix => undef, + @_ + ); + + my $attributes = $args{'AttributesRef'}; + my $ARGSRef = $args{'ARGSRef'}; + my %new_values; + + # gather all new values + foreach my $attribute (@$attributes) { + my $value; + if ( defined $ARGSRef->{$attribute} ) { + $value = $ARGSRef->{$attribute}; + } + elsif ( + defined( $args{'AttributePrefix'} ) + && defined( + $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute } + ) + ) { + $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }; + + } + else { + next; + } + + $value =~ s/\r\n/\n/gs; + + my $truncated_value = $self->TruncateValue($attribute, $value); + + # If Queue is 'General', we want to resolve the queue name for + # the object. + + # This is in an eval block because $object might not exist. + # and might not have a Name method. But "can" won't find autoloaded + # items. If it fails, we don't care + do { + no warnings "uninitialized"; + local $@; + eval { + my $object = $attribute . "Obj"; + my $name = $self->$object->Name; + next if $name eq $value || $name eq ($value || 0); + }; + + my $current = $self->$attribute(); + # RT::Queue->Lifecycle returns a Lifecycle object instead of name + $current = eval { $current->Name } if ref $current; + next if $truncated_value eq $current; + next if ( $truncated_value || 0 ) eq $current; + }; + + $new_values{$attribute} = $value; + } + + return $self->_UpdateAttributes( + Attributes => $attributes, + NewValues => \%new_values, + ); +} + +sub _UpdateAttributes { + my $self = shift; + my %args = ( + Attributes => [], + NewValues => {}, + @_, + ); + + my @results; + + foreach my $attribute (@{ $args{Attributes} }) { + next if !exists($args{NewValues}{$attribute}); + + my $value = $args{NewValues}{$attribute}; + my $method = "Set$attribute"; + my ( $code, $msg ) = $self->$method($value); + my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/; + + # Default to $id, but use name if we can get it. + my $label = $self->id; + $label = $self->Name if (UNIVERSAL::can($self,'Name')); + # this requires model names to be loc'ed. + +=for loc + + "Ticket" # loc + "User" # loc + "Group" # loc + "Queue" # loc + +=cut + + push @results, $self->loc( $prefix ) . " $label: ". $msg; + +=for loc + + "[_1] could not be set to [_2].", # loc + "That is already the current value", # loc + "No value sent to _Set!", # loc + "Illegal value for [_1]", # loc + "The new value has been set.", # loc + "No column specified", # loc + "Immutable field", # loc + "Nonexistant field?", # loc + "Invalid data", # loc + "Couldn't find row", # loc + "Missing a primary key?: [_1]", # loc + "Found Object", # loc + +=cut + + } + + return @results; +} + + + + +=head2 Members + + This returns an RT::Links object which references all the tickets +which are 'MembersOf' this ticket + +=cut + +sub Members { + my $self = shift; + return ( $self->_Links( 'Target', 'MemberOf' ) ); +} + + + +=head2 MemberOf + + This returns an RT::Links object which references all the tickets that this +ticket is a 'MemberOf' + +=cut + +sub MemberOf { + my $self = shift; + return ( $self->_Links( 'Base', 'MemberOf' ) ); +} + + + +=head2 RefersTo + + This returns an RT::Links object which shows all references for which this ticket is a base + +=cut + +sub RefersTo { + my $self = shift; + return ( $self->_Links( 'Base', 'RefersTo' ) ); +} + + + +=head2 ReferredToBy + +This returns an L<RT::Links> object which shows all references for which this ticket is a target + +=cut + +sub ReferredToBy { + my $self = shift; + return ( $self->_Links( 'Target', 'RefersTo' ) ); +} + + + +=head2 DependedOnBy + + This returns an RT::Links object which references all the tickets that depend on this one + +=cut + +sub DependedOnBy { + my $self = shift; + return ( $self->_Links( 'Target', 'DependsOn' ) ); +} + + + + +=head2 HasUnresolvedDependencies + +Takes a paramhash of Type (default to '__any'). Returns the number of +unresolved dependencies, if $self->UnresolvedDependencies returns an +object with one or more members of that type. Returns false +otherwise. + +=cut + +sub HasUnresolvedDependencies { + my $self = shift; + my %args = ( + Type => undef, + @_ + ); + + my $deps = $self->UnresolvedDependencies; + + if ($args{Type}) { + $deps->Limit( FIELD => 'Type', + OPERATOR => '=', + VALUE => $args{Type}); + } + else { + $deps->IgnoreType; + } + + if ($deps->Count > 0) { + return $deps->Count; + } + else { + return (undef); + } +} + + + +=head2 UnresolvedDependencies + +Returns an RT::Tickets object of tickets which this ticket depends on +and which have a status of new, open or stalled. (That list comes from +RT::Queue->ActiveStatusArray + +=cut + + +sub UnresolvedDependencies { + my $self = shift; + my $deps = RT::Tickets->new($self->CurrentUser); + + my @live_statuses = RT::Queue->ActiveStatusArray(); + foreach my $status (@live_statuses) { + $deps->LimitStatus(VALUE => $status); + } + $deps->LimitDependedOnBy($self->Id); + + return($deps); + +} + + + +=head2 AllDependedOnBy + +Returns an array of RT::Ticket objects which (directly or indirectly) +depends on this ticket; takes an optional 'Type' argument in the param +hash, which will limit returned tickets to that type, as well as cause +tickets with that type to serve as 'leaf' nodes that stops the recursive +dependency search. + +=cut + +sub AllDependedOnBy { + my $self = shift; + return $self->_AllLinkedTickets( LinkType => 'DependsOn', + Direction => 'Target', @_ ); +} + +=head2 AllDependsOn + +Returns an array of RT::Ticket objects which this ticket (directly or +indirectly) depends on; takes an optional 'Type' argument in the param +hash, which will limit returned tickets to that type, as well as cause +tickets with that type to serve as 'leaf' nodes that stops the +recursive dependency search. + +=cut + +sub AllDependsOn { + my $self = shift; + return $self->_AllLinkedTickets( LinkType => 'DependsOn', + Direction => 'Base', @_ ); +} + +sub _AllLinkedTickets { + my $self = shift; + + my %args = ( + LinkType => undef, + Direction => undef, + Type => undef, + _found => {}, + _top => 1, + @_ + ); + + my $dep = $self->_Links( $args{Direction}, $args{LinkType}); + while (my $link = $dep->Next()) { + my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI; + next unless ($uri->IsLocal()); + my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj; + next if $args{_found}{$obj->Id}; + + if (!$args{Type}) { + $args{_found}{$obj->Id} = $obj; + $obj->_AllLinkedTickets( %args, _top => 0 ); + } + elsif ($obj->Type and $obj->Type eq $args{Type}) { + $args{_found}{$obj->Id} = $obj; + } + else { + $obj->_AllLinkedTickets( %args, _top => 0 ); + } + } + + if ($args{_top}) { + return map { $args{_found}{$_} } sort keys %{$args{_found}}; + } + else { + return 1; + } +} + + + +=head2 DependsOn + + This returns an RT::Links object which references all the tickets that this ticket depends on + +=cut + +sub DependsOn { + my $self = shift; + return ( $self->_Links( 'Base', 'DependsOn' ) ); +} + +# }}} + +# {{{ Customers + +=head2 Customers + + This returns an RT::Links object which references all the customers that + this object is a member of. This includes both explicitly linked customers + and links implied by services. + +=cut + +sub Customers { + my( $self, %opt ) = @_; + my $Debug = $opt{'Debug'}; + + unless ( $self->{'Customers'} ) { + + $self->{'Customers'} = $self->MemberOf->Clone; + + for my $fstable (qw(cust_main cust_svc)) { + + $self->{'Customers'}->Limit( + FIELD => 'Target', + OPERATOR => 'STARTSWITH', + VALUE => "freeside://freeside/$fstable", + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => 'customers', + ); + } + } + + warn "->Customers method called on $self; returning ". + ref($self->{'Customers'}). ' object' + if $Debug; + + return $self->{'Customers'}; +} + +# }}} + +# {{{ Services + +=head2 Services + + This returns an RT::Links object which references all the services this + object is a member of. + +=cut + +sub Services { + my( $self, %opt ) = @_; + + unless ( $self->{'Services'} ) { + + $self->{'Services'} = $self->MemberOf->Clone; + + $self->{'Services'}->Limit( + FIELD => 'Target', + OPERATOR => 'STARTSWITH', + VALUE => "freeside://freeside/cust_svc", + ); + } + + return $self->{'Services'}; +} + + + + + + +=head2 Links DIRECTION [TYPE] + +Return links (L<RT::Links>) to/from this object. + +DIRECTION is either 'Base' or 'Target'. + +TYPE is a type of links to return, it can be omitted to get +links of any type. + +=cut + +sub Links { shift->_Links(@_) } + +sub _Links { + my $self = shift; + + #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic --- + #tobias meant by $f + my $field = shift; + my $type = shift || ""; + + unless ( $self->{"$field$type"} ) { + $self->{"$field$type"} = RT::Links->new( $self->CurrentUser ); + # at least to myself + $self->{"$field$type"}->Limit( FIELD => $field, + VALUE => $self->URI, + ENTRYAGGREGATOR => 'OR' ); + $self->{"$field$type"}->Limit( FIELD => 'Type', + VALUE => $type ) + if ($type); + } + return ( $self->{"$field$type"} ); +} + + + + +=head2 FormatType + +Takes a Type and returns a string that is more human readable. + +=cut + +sub FormatType{ + my $self = shift; + my %args = ( Type => '', + @_ + ); + $args{Type} =~ s/([A-Z])/" " . lc $1/ge; + $args{Type} =~ s/^\s+//; + return $args{Type}; +} + + + + +=head2 FormatLink + +Takes either a Target or a Base and returns a string of human friendly text. + +=cut + +sub FormatLink { + my $self = shift; + my %args = ( Object => undef, + FallBack => '', + @_ + ); + my $text = "URI " . $args{FallBack}; + if ($args{Object} && $args{Object}->isa("RT::Ticket")) { + $text = "Ticket " . $args{Object}->id; + } + return $text; +} + + + +=head2 _AddLink + +Takes a paramhash of Type and one of Base or Target. Adds that link to this object. + +Returns C<link id>, C<message> and C<exist> flag. + + +=cut + +sub _AddLink { + my $self = shift; + my %args = ( Target => '', + Base => '', + Type => '', + Silent => undef, + @_ ); + + + # Remote_link is the URI of the object that is not this ticket + my $remote_link; + my $direction; + + if ( $args{'Base'} and $args{'Target'} ) { + $RT::Logger->debug( "$self tried to create a link. both base and target were specified" ); + return ( 0, $self->loc("Can't specify both base and target") ); + } + elsif ( $args{'Base'} ) { + $args{'Target'} = $self->URI(); + $remote_link = $args{'Base'}; + $direction = 'Target'; + } + elsif ( $args{'Target'} ) { + $args{'Base'} = $self->URI(); + $remote_link = $args{'Target'}; + $direction = 'Base'; + } + else { + return ( 0, $self->loc('Either base or target must be specified') ); + } + + # Check if the link already exists - we don't want duplicates + use RT::Link; + my $old_link = RT::Link->new( $self->CurrentUser ); + $old_link->LoadByParams( Base => $args{'Base'}, + Type => $args{'Type'}, + Target => $args{'Target'} ); + if ( $old_link->Id ) { + $RT::Logger->debug("$self Somebody tried to duplicate a link"); + return ( $old_link->id, $self->loc("Link already exists"), 1 ); + } + + # }}} + + + # Storing the link in the DB. + my $link = RT::Link->new( $self->CurrentUser ); + my ($linkid, $linkmsg) = $link->Create( Target => $args{Target}, + Base => $args{Base}, + Type => $args{Type} ); + + unless ($linkid) { + $RT::Logger->error("Link could not be created: ".$linkmsg); + return ( 0, $self->loc("Link could not be created") ); + } + + my $basetext = $self->FormatLink(Object => $link->BaseObj, + FallBack => $args{Base}); + my $targettext = $self->FormatLink(Object => $link->TargetObj, + FallBack => $args{Target}); + my $typetext = $self->FormatType(Type => $args{Type}); + my $TransString = + "$basetext $typetext $targettext."; + return ( $linkid, $TransString ) ; +} + + + +=head2 _DeleteLink + +Delete a link. takes a paramhash of Base, Target and Type. +Either Base or Target must be null. The null value will +be replaced with this ticket's id + +=cut + +sub _DeleteLink { + my $self = shift; + my %args = ( + Base => undef, + Target => undef, + Type => undef, + @_ + ); + + #we want one of base and target. we don't care which + #but we only want _one_ + + my $direction; + my $remote_link; + + if ( $args{'Base'} and $args{'Target'} ) { + $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target"); + return ( 0, $self->loc("Can't specify both base and target") ); + } + elsif ( $args{'Base'} ) { + $args{'Target'} = $self->URI(); + $remote_link = $args{'Base'}; + $direction = 'Target'; + } + elsif ( $args{'Target'} ) { + $args{'Base'} = $self->URI(); + $remote_link = $args{'Target'}; + $direction='Base'; + } + else { + $RT::Logger->error("Base or Target must be specified"); + return ( 0, $self->loc('Either base or target must be specified') ); + } + + my $link = RT::Link->new( $self->CurrentUser ); + $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} ); + + + $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} ); + #it's a real link. + + if ( $link->id ) { + my $basetext = $self->FormatLink(Object => $link->BaseObj, + FallBack => $args{Base}); + my $targettext = $self->FormatLink(Object => $link->TargetObj, + FallBack => $args{Target}); + my $typetext = $self->FormatType(Type => $args{Type}); + my $linkid = $link->id; + $link->Delete(); + my $TransString = "$basetext no longer $typetext $targettext."; + return ( 1, $TransString); + } + + #if it's not a link we can find + else { + $RT::Logger->debug("Couldn't find that link"); + return ( 0, $self->loc("Link not found") ); + } +} + + +=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 + +Private function to create a new RT::Transaction object for this ticket update + +=cut + +sub _NewTransaction { + my $self = shift; + my %args = ( + TimeTaken => undef, + Type => undef, + OldValue => undef, + NewValue => undef, + OldReference => undef, + NewReference => undef, + ReferenceType => undef, + Data => undef, + Field => undef, + MIMEObj => undef, + ActivateScrips => 1, + CommitScrips => 1, + SquelchMailTo => undef, + CustomFields => {}, + @_ + ); + + 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'}; + if ($old_ref or $new_ref) { + $ref_type ||= ref($old_ref) || ref($new_ref); + if (!$ref_type) { + $RT::Logger->error("Reference type not specified for transaction"); + return; + } + $old_ref = $old_ref->Id if ref($old_ref); + $new_ref = $new_ref->Id if ref($new_ref); + } + + require RT::Transaction; + my $trans = RT::Transaction->new( $self->CurrentUser ); + my ( $transaction, $msg ) = $trans->Create( + ObjectId => $self->Id, + ObjectType => ref($self), + TimeTaken => $args{'TimeTaken'}, + Type => $args{'Type'}, + Data => $args{'Data'}, + Field => $args{'Field'}, + NewValue => $args{'NewValue'}, + OldValue => $args{'OldValue'}, + NewReference => $new_ref, + OldReference => $old_ref, + ReferenceType => $ref_type, + MIMEObj => $args{'MIMEObj'}, + ActivateScrips => $args{'ActivateScrips'}, + CommitScrips => $args{'CommitScrips'}, + SquelchMailTo => $args{'SquelchMailTo'}, + CustomFields => $args{'CustomFields'}, + ); + + # Rationalize the object since we may have done things to it during the caching. + $self->Load($self->Id); + + $RT::Logger->warning($msg) unless $transaction; + + $self->_SetLastUpdated; + + if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) { + $self->_UpdateTimeTaken( $args{'TimeTaken'} ); + } + if ( RT->Config->Get('UseTransactionBatch') and $transaction ) { + push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; + } + + RT->DatabaseHandle->Commit unless $in_txn; + + return ( $transaction, $msg, $trans ); +} + + + +=head2 Transactions + + Returns an RT::Transactions object of all transactions on this record object + +=cut + +sub Transactions { + my $self = shift; + + use RT::Transactions; + my $transactions = RT::Transactions->new( $self->CurrentUser ); + + #If the user has no rights, return an empty object + $transactions->Limit( + FIELD => 'ObjectId', + VALUE => $self->id, + ); + $transactions->Limit( + FIELD => 'ObjectType', + VALUE => ref($self), + ); + + return ($transactions); +} + +# + +sub CustomFields { + my $self = shift; + my $cfs = RT::CustomFields->new( $self->CurrentUser ); + + $cfs->SetContextObject( $self ); + # XXX handle multiple types properly + $cfs->LimitToLookupType( $self->CustomFieldLookupType ); + $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId ); + $cfs->ApplySortOrder; + + return $cfs; +} + +# TODO: This _only_ works for RT::Foo classes. it doesn't work, for +# example, for RT::IR::Foo classes. + +sub CustomFieldLookupId { + my $self = shift; + my $lookup = shift || $self->CustomFieldLookupType; + my @classes = ($lookup =~ /RT::(\w+)-/g); + + # Work on "RT::Queue", for instance + return $self->Id unless @classes; + + my $object = $self; + # Save a ->Load call by not calling ->FooObj->Id, just ->Foo + my $final = shift @classes; + foreach my $class (reverse @classes) { + my $method = "${class}Obj"; + $object = $object->$method; + } + + my $id = $object->$final; + unless (defined $id) { + my $method = "${final}Obj"; + $id = $object->$method->Id; + } + return $id; +} + + +=head2 CustomFieldLookupType + +Returns the path RT uses to figure out which custom fields apply to this object. + +=cut + +sub CustomFieldLookupType { + my $self = shift; + return ref($self) || $self; +} + + +=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE } + +VALUE should be a string. FIELD can be any identifier of a CustomField +supported by L</LoadCustomFieldByIdentifier> method. + +Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field, +deletes the old value. +If VALUE is not a valid value for the custom field, returns +(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where +$id is ID of created L<ObjectCustomFieldValue> object. + +=cut + +sub AddCustomFieldValue { + my $self = shift; + $self->_AddCustomFieldValue(@_); +} + +sub _AddCustomFieldValue { + my $self = shift; + my %args = ( + Field => undef, + Value => undef, + LargeContent => undef, + ContentType => undef, + RecordTransaction => 1, + @_ + ); + + my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); + unless ( $cf->Id ) { + return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); + } + + my $OCFs = $self->CustomFields; + $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id ); + unless ( $OCFs->Count ) { + return ( + 0, + $self->loc( + "Custom field [_1] does not apply to this object", + ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'} + ) + ); + } + + # empty string is not correct value of any CF, so undef it + foreach ( qw(Value LargeContent) ) { + $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ }; + } + + unless ( $cf->ValidateValue( $args{'Value'} ) ) { + return ( 0, $self->loc("Invalid value for custom field") ); + } + + # If the custom field only accepts a certain # of values, delete the existing + # value and record a "changed from foo to bar" transaction + unless ( $cf->UnlimitedValues ) { + + # Load up a ObjectCustomFieldValues object for this custom field and this ticket + my $values = $cf->ValuesForObject($self); + + # We need to whack any old values here. In most cases, the custom field should + # only have one value to delete. In the pathalogical case, this custom field + # used to be a multiple and we have many values to whack.... + my $cf_values = $values->Count; + + if ( $cf_values > $cf->MaxValues ) { + my $i = 0; #We want to delete all but the max we can currently have , so we can then + # execute the same code to "change" the value from old to new + while ( my $value = $values->Next ) { + $i++; + if ( $i < $cf_values ) { + my ( $val, $msg ) = $cf->DeleteValueForObject( + Object => $self, + Id => $value->id, + ); + unless ($val) { + return ( 0, $msg ); + } + my ( $TransactionId, $Msg, $TransactionObj ) = + $self->_NewTransaction( + Type => 'CustomField', + Field => $cf->Id, + OldReference => $value, + ); + } + } + $values->RedoSearch if $i; # redo search if have deleted at least one value + } + + if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { + return $entry->id; + } + + my $old_value = $values->First; + my $old_content; + $old_content = $old_value->Content if $old_value; + + my ( $new_value_id, $value_msg ) = $cf->AddValueForObject( + Object => $self, + Content => $args{'Value'}, + LargeContent => $args{'LargeContent'}, + ContentType => $args{'ContentType'}, + ); + + unless ( $new_value_id ) { + return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) ); + } + + my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser ); + $new_value->Load( $new_value_id ); + + # now that adding the new value was successful, delete the old one + if ( $old_value ) { + my ( $val, $msg ) = $old_value->Delete(); + return ( 0, $msg ) unless $val; + } + + if ( $args{'RecordTransaction'} ) { + my ( $TransactionId, $Msg, $TransactionObj ) = + $self->_NewTransaction( + Type => 'CustomField', + Field => $cf->Id, + OldReference => $old_value, + NewReference => $new_value, + ); + } + + my $new_content = $new_value->Content; + + # For datetime, we need to display them in "human" format in result message + #XXX TODO how about date without time? + if ($cf->Type eq 'DateTime') { + my $DateObj = RT::Date->new( $self->CurrentUser ); + $DateObj->Set( + Format => 'ISO', + Value => $new_content, + ); + $new_content = $DateObj->AsString; + + if ( defined $old_content && length $old_content ) { + $DateObj->Set( + Format => 'ISO', + Value => $old_content, + ); + $old_content = $DateObj->AsString; + } + } + + unless ( defined $old_content && length $old_content ) { + return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content )); + } + elsif ( !defined $new_content || !length $new_content ) { + return ( $new_value_id, + $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) ); + } + else { + return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content)); + } + + } + + # otherwise, just add a new value and record "new value added" + else { + if ( !$cf->Repeated ) { + my $values = $cf->ValuesForObject($self); + if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { + return $entry->id; + } + } + + my ($new_value_id, $msg) = $cf->AddValueForObject( + Object => $self, + Content => $args{'Value'}, + LargeContent => $args{'LargeContent'}, + ContentType => $args{'ContentType'}, + ); + + unless ( $new_value_id ) { + return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) ); + } + if ( $args{'RecordTransaction'} ) { + my ( $tid, $msg ) = $self->_NewTransaction( + Type => 'CustomField', + Field => $cf->Id, + NewReference => $new_value_id, + ReferenceType => 'RT::ObjectCustomFieldValue', + ); + unless ( $tid ) { + return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) ); + } + } + return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) ); + } +} + + + +=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE } + +Deletes VALUE as a value of CustomField FIELD. + +VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue. + +If VALUE is not a valid value for the custom field, returns +(0, 'Error message' ) otherwise, returns (1, 'Success Message') + +=cut + +sub DeleteCustomFieldValue { + my $self = shift; + my %args = ( + Field => undef, + Value => undef, + ValueId => undef, + @_ + ); + + my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); + unless ( $cf->Id ) { + return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); + } + + my ( $val, $msg ) = $cf->DeleteValueForObject( + Object => $self, + Id => $args{'ValueId'}, + Content => $args{'Value'}, + ); + unless ($val) { + return ( 0, $msg ); + } + + my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction( + Type => 'CustomField', + Field => $cf->Id, + OldReference => $val, + ReferenceType => 'RT::ObjectCustomFieldValue', + ); + unless ($TransactionId) { + return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) ); + } + + my $old_value = $TransactionObj->OldValue; + # For datetime, we need to display them in "human" format in result message + if ( $cf->Type eq 'DateTime' ) { + my $DateObj = RT::Date->new( $self->CurrentUser ); + $DateObj->Set( + Format => 'ISO', + Value => $old_value, + ); + $old_value = $DateObj->AsString; + } + return ( + $TransactionId, + $self->loc( + "[_1] is no longer a value for custom field [_2]", + $old_value, $cf->Name + ) + ); +} + + + +=head2 FirstCustomFieldValue FIELD + +Return the content of the first value of CustomField FIELD for this ticket +Takes a field id or name + +=cut + +sub FirstCustomFieldValue { + my $self = shift; + my $field = shift; + + my $values = $self->CustomFieldValues( $field ); + return undef unless my $first = $values->First; + return $first->Content; +} + +=head2 CustomFieldValuesAsString FIELD + +Return the content of the CustomField FIELD for this ticket. +If this is a multi-value custom field, values will be joined with newlines. + +Takes a field id or name as the first argument + +Takes an optional Separator => "," second and third argument +if you want to join the values using something other than a newline + +=cut + +sub CustomFieldValuesAsString { + my $self = shift; + my $field = shift; + my %args = @_; + my $separator = $args{Separator} || "\n"; + + my $values = $self->CustomFieldValues( $field ); + return join ($separator, grep { defined $_ } + map { $_->Content } @{$values->ItemsArrayRef}); +} + + + +=head2 CustomFieldValues FIELD + +Return a ObjectCustomFieldValues object of all values of the CustomField whose +id or Name is FIELD for this record. + +Returns an RT::ObjectCustomFieldValues object + +=cut + +sub CustomFieldValues { + my $self = shift; + my $field = shift; + + if ( $field ) { + my $cf = $self->LoadCustomFieldByIdentifier( $field ); + + # we were asked to search on a custom field we couldn't find + unless ( $cf->id ) { + $RT::Logger->warning("Couldn't load custom field by '$field' identifier"); + return RT::ObjectCustomFieldValues->new( $self->CurrentUser ); + } + return ( $cf->ValuesForObject($self) ); + } + + # we're not limiting to a specific custom field; + my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser ); + $ocfs->LimitToObject( $self ); + return $ocfs; +} + +=head2 LoadCustomFieldByIdentifier IDENTIFER + +Find the custom field has id or name IDENTIFIER for this object. + +If no valid field is found, returns an empty RT::CustomField object. + +=cut + +sub LoadCustomFieldByIdentifier { + my $self = shift; + my $field = shift; + + my $cf; + if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) { + $cf = RT::CustomField->new($self->CurrentUser); + $cf->SetContextObject( $self ); + $cf->LoadById( $field->id ); + } + elsif ($field =~ /^\d+$/) { + $cf = RT::CustomField->new($self->CurrentUser); + $cf->SetContextObject( $self ); + $cf->LoadById($field); + } else { + + my $cfs = $self->CustomFields($self->CurrentUser); + $cfs->SetContextObject( $self ); + $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0); + $cf = $cfs->First || RT::CustomField->new($self->CurrentUser); + } + return $cf; +} + +sub ACLEquivalenceObjects { } + +sub BasicColumns { } + +sub WikiBase { + return RT->Config->Get('WebPath'). "/index.html?q="; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Shredder.pm b/rt/lib/RT/Shredder.pm index 125ed0dc4..8022775dd 100644 --- a/rt/lib/RT/Shredder.pm +++ b/rt/lib/RT/Shredder.pm @@ -180,6 +180,8 @@ shredding on most databases. CREATE INDEX SHREDDER_TXN3 ON Transactions(Type, OldValue); CREATE INDEX SHREDDER_TXN4 ON Transactions(Type, NewValue) + CREATE INDEX SHREDDER_ATTACHMENTS1 ON Attachments(Creator); + =head1 INFORMATION FOR DEVELOPERS =head2 General API diff --git a/rt/lib/RT/Template.pm b/rt/lib/RT/Template.pm index 050799714..a6c0f7d0b 100755 --- a/rt/lib/RT/Template.pm +++ b/rt/lib/RT/Template.pm @@ -307,10 +307,9 @@ sub IsEmpty { Returns L<MIME::Entity> object parsed using L</Parse> method. Returns undef if last call to L</Parse> failed or never be called. -Note that content of the template is UTF-8, but L<MIME::Parser> is not -good at handling it and all data of the entity should be treated as -octets and converted to perl strings using Encode::decode_utf8 or -something else. +Note that content of the template is characters, but the contents of all +L<MIME::Entity> objects (including the one returned by this function, +are bytes in UTF-8. =cut @@ -384,8 +383,8 @@ sub _Parse { ### Should we forgive normally-fatal errors? $parser->ignore_errors(1); - # MIME::Parser doesn't play well with perl strings - utf8::encode($content); + # Always provide bytes, not characters, to MIME objects + $content = Encode::encode( 'UTF-8', $content ); $self->{'MIMEObj'} = eval { $parser->parse_data( \$content ) }; if ( my $error = $@ || $parser->last_error ) { $RT::Logger->error( "$error" ); @@ -602,17 +601,17 @@ sub _DowngradeFromHTML { require HTML::FormatText; require HTML::TreeBuilder; - require Encode; - # need to decode_utf8, see the doc of MIMEObj method + # MIME objects are always bytes, not characters my $tree = HTML::TreeBuilder->new_from_content( - Encode::decode_utf8($new_entity->bodyhandle->as_string) + Encode::decode( 'UTF-8', $new_entity->bodyhandle->as_string) ); - $new_entity->bodyhandle(MIME::Body::InCore->new( - \(scalar HTML::FormatText->new( - leftmargin => 0, - rightmargin => 78, - )->format( $tree )) - )); + my $text = HTML::FormatText->new( + leftmargin => 0, + rightmargin => 78, + )->format( $tree ); + $text = Encode::encode( "UTF-8", $text ); + + $new_entity->bodyhandle(MIME::Body::InCore->new( \$text )); $tree->delete; $orig_entity->add_part($new_entity, 0); # plain comes before html diff --git a/rt/lib/RT/Test.pm b/rt/lib/RT/Test.pm index 19dc26378..104e93a63 100644 --- a/rt/lib/RT/Test.pm +++ b/rt/lib/RT/Test.pm @@ -164,6 +164,8 @@ sub import { $class->set_config_wrapper; + $class->encode_output; + my $screen_logger = $RT::Logger->remove( 'screen' ); require Log::Dispatch::Perl; $RT::Logger->add( Log::Dispatch::Perl->new @@ -417,6 +419,13 @@ sub set_config_wrapper { }; } +sub encode_output { + my $builder = Test::More->builder; + binmode $builder->output, ":encoding(utf8)"; + binmode $builder->failure_output, ":encoding(utf8)"; + binmode $builder->todo_output, ":encoding(utf8)"; +} + sub bootstrap_db { my $self = shift; my %args = @_; @@ -639,12 +648,7 @@ sub __init_logging { $filter = $SIG{__WARN__}; } $SIG{__WARN__} = sub { - if ($filter) { - my $status = $filter->(@_); - if ($status and $status eq 'IGNORE') { - return; # pretend the bad dream never happened - } - } + $filter->(@_) if $filter; # Avoid reporting this anonymous call frame as the source of the warning. goto &$Test_NoWarnings_Catcher; }; @@ -824,9 +828,11 @@ sub create_ticket { if ( my $content = delete $args{'Content'} ) { $args{'MIMEObj'} = MIME::Entity->build( - From => $args{'Requestor'}, - Subject => $args{'Subject'}, - Data => $content, + From => Encode::encode( "UTF-8", $args{'Requestor'} ), + Subject => RT::Interface::Email::EncodeToMIME( String => $args{'Subject'} ), + Type => "text/plain", + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $content ), ); } diff --git a/rt/lib/RT/Ticket.pm b/rt/lib/RT/Ticket.pm index c3d4c2773..91a7fb581 100755 --- a/rt/lib/RT/Ticket.pm +++ b/rt/lib/RT/Ticket.pm @@ -858,10 +858,10 @@ sub _Parse822HeadersForAttributes { } $args{$date} = $dateobj->ISO; } - $args{'mimeobj'} = MIME::Entity->new(); - $args{'mimeobj'}->build( - Type => ( $args{'contenttype'} || 'text/plain' ), - Data => ($args{'content'} || '') + $args{'mimeobj'} = MIME::Entity->build( + Type => ( $args{'contenttype'} || 'text/plain' ), + Charset => "UTF-8", + Data => Encode::encode("UTF-8", ($args{'content'} || '')) ); return (%args); @@ -2344,8 +2344,11 @@ sub _RecordNote { } unless ( $args{'MIMEObj'} ) { + my $data = ref $args{'Content'}? $args{'Content'} : [ $args{'Content'} ]; $args{'MIMEObj'} = MIME::Entity->build( - Data => ( ref $args{'Content'}? $args{'Content'}: [ $args{'Content'} ] ) + Type => "text/plain", + Charset => "UTF-8", + Data => [ map {Encode::encode("UTF-8", $_)} @{$data} ], ); } @@ -2367,13 +2370,13 @@ sub _RecordNote { my $addresses = join ', ', ( map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse( $args{ $type . 'MessageTo' } ) ); - $args{'MIMEObj'}->head->replace( 'RT-Send-' . $type, Encode::encode_utf8( $addresses ) ); + $args{'MIMEObj'}->head->replace( 'RT-Send-' . $type, Encode::encode( "UTF-8", $addresses ) ); } } foreach my $argument (qw(Encrypt Sign)) { $args{'MIMEObj'}->head->replace( - "X-RT-$argument" => Encode::encode_utf8( $args{ $argument } ) + "X-RT-$argument" => Encode::encode( "UTF-8", $args{ $argument } ) ) if defined $args{ $argument }; } @@ -2381,10 +2384,10 @@ sub _RecordNote { # internal Message-ID now, so all emails sent because of this # message have a common Message-ID my $org = RT->Config->Get('Organization'); - my $msgid = $args{'MIMEObj'}->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $args{'MIMEObj'}->head->get('Message-ID') ); unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) { $args{'MIMEObj'}->head->set( - 'RT-Message-ID' => Encode::encode_utf8( + 'RT-Message-ID' => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId( Ticket => $self ) ) ); @@ -2393,7 +2396,7 @@ sub _RecordNote { #Record the correspondence (write the transaction) my ( $Trans, $msg, $TransObj ) = $self->_NewTransaction( Type => $args{'NoteType'}, - Data => ( $args{'MIMEObj'}->head->get('subject') || 'No Subject' ), + Data => ( Encode::decode( "UTF-8", $args{'MIMEObj'}->head->get('Subject') ) || 'No Subject' ), TimeTaken => $args{'TimeTaken'}, MIMEObj => $args{'MIMEObj'}, CommitScrips => $args{'CommitScrips'}, @@ -2429,10 +2432,10 @@ sub DryRun { } my $Message = MIME::Entity->build( + Subject => defined $args{UpdateSubject} ? Encode::encode( "UTF-8", $args{UpdateSubject} ) : "", Type => 'text/plain', - Subject => defined $args{UpdateSubject} ? Encode::encode_utf8( $args{UpdateSubject} ) : "", Charset => 'UTF-8', - Data => $args{'UpdateContent'} || "", + Data => Encode::encode("UTF-8", $args{'UpdateContent'} || ""), ); my ( $Transaction, $Description, $Object ) = $self->$action( @@ -2461,12 +2464,12 @@ sub DryRunCreate { my $self = shift; my %args = @_; my $Message = MIME::Entity->build( - Type => 'text/plain', - Subject => defined $args{Subject} ? Encode::encode_utf8( $args{'Subject'} ) : "", + Subject => defined $args{Subject} ? Encode::encode( "UTF-8", $args{'Subject'} ) : "", (defined $args{'Cc'} ? - ( Cc => Encode::encode_utf8( $args{'Cc'} ) ) : ()), + ( Cc => Encode::encode( "UTF-8", $args{'Cc'} ) ) : ()), + Type => 'text/plain', Charset => 'UTF-8', - Data => $args{'Content'} || "", + Data => Encode::encode( "UTF-8", $args{'Content'} || ""), ); my ( $Transaction, $Object, $Description ) = $self->Create( diff --git a/rt/lib/RT/Ticket.pm.orig b/rt/lib/RT/Ticket.pm.orig new file mode 100755 index 000000000..c3d4c2773 --- /dev/null +++ b/rt/lib/RT/Ticket.pm.orig @@ -0,0 +1,4379 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +=head1 SYNOPSIS + + use RT::Ticket; + my $ticket = RT::Ticket->new($CurrentUser); + $ticket->Load($ticket_id); + +=head1 DESCRIPTION + +This module lets you manipulate RT's ticket object. + + +=head1 METHODS + + +=cut + + +package RT::Ticket; + +use strict; +use warnings; + + +use RT::Queue; +use RT::User; +use RT::Record; +use RT::Links; +use RT::Date; +use RT::CustomFields; +use RT::Tickets; +use RT::Transactions; +use RT::Reminders; +use RT::URI::fsck_com_rt; +use RT::URI; +use RT::URI::freeside; +use MIME::Entity; +use Devel::GlobalDestruction; + + +# A helper table for links mapping to make it easier +# to build and parse links between tickets + +our %LINKTYPEMAP = ( + MemberOf => { Type => 'MemberOf', + Mode => 'Target', }, + Parents => { Type => 'MemberOf', + Mode => 'Target', }, + Members => { Type => 'MemberOf', + Mode => 'Base', }, + Children => { Type => 'MemberOf', + Mode => 'Base', }, + HasMember => { Type => 'MemberOf', + Mode => 'Base', }, + RefersTo => { Type => 'RefersTo', + Mode => 'Target', }, + ReferredToBy => { Type => 'RefersTo', + Mode => 'Base', }, + DependsOn => { Type => 'DependsOn', + Mode => 'Target', }, + DependedOnBy => { Type => 'DependsOn', + Mode => 'Base', }, + MergedInto => { Type => 'MergedInto', + Mode => 'Target', }, + +); + + +# A helper table for links mapping to make it easier +# to build and parse links between tickets + +our %LINKDIRMAP = ( + MemberOf => { Base => 'MemberOf', + Target => 'HasMember', }, + RefersTo => { Base => 'RefersTo', + Target => 'ReferredToBy', }, + DependsOn => { Base => 'DependsOn', + Target => 'DependedOnBy', }, + MergedInto => { Base => 'MergedInto', + Target => 'MergedInto', }, + +); + + +sub LINKTYPEMAP { return \%LINKTYPEMAP } +sub LINKDIRMAP { return \%LINKDIRMAP } + +our %MERGE_CACHE = ( + effective => {}, + merged => {}, +); + + +=head2 Load + +Takes a single argument. This can be a ticket id, ticket alias or +local ticket uri. If the ticket can't be loaded, returns undef. +Otherwise, returns the ticket id. + +=cut + +sub Load { + my $self = shift; + my $id = shift; + $id = '' unless defined $id; + + # TODO: modify this routine to look at EffectiveId and + # do the recursive load thing. be careful to cache all + # the interim tickets we try so we don't loop forever. + + unless ( $id =~ /^\d+$/ ) { + $RT::Logger->debug("Tried to load a bogus ticket id: '$id'"); + return (undef); + } + + $id = $MERGE_CACHE{'effective'}{ $id } + if $MERGE_CACHE{'effective'}{ $id }; + + my ($ticketid, $msg) = $self->LoadById( $id ); + unless ( $self->Id ) { + $RT::Logger->debug("$self tried to load a bogus ticket: $id"); + return (undef); + } + + #If we're merged, resolve the merge. + if ( $self->EffectiveId && $self->EffectiveId != $self->Id ) { + $RT::Logger->debug( + "We found a merged ticket. " + . $self->id ."/". $self->EffectiveId + ); + my $real_id = $self->Load( $self->EffectiveId ); + $MERGE_CACHE{'effective'}{ $id } = $real_id; + return $real_id; + } + + #Ok. we're loaded. lets get outa here. + return $self->Id; +} + + + +=head2 Create (ARGS) + +Arguments: ARGS is a hash of named parameters. Valid parameters are: + + id + Queue - Either a Queue object or a Queue Name + Requestor - A reference to a list of email addresses or RT user Names + Cc - A reference to a list of email addresses or Names + AdminCc - A reference to a list of email addresses or Names + SquelchMailTo - A reference to a list of email addresses - + who should this ticket not mail + Type -- The ticket's type. ignore this for now + Owner -- This ticket's owner. either an RT::User object or this user's id + Subject -- A string describing the subject of the ticket + Priority -- an integer from 0 to 99 + InitialPriority -- an integer from 0 to 99 + FinalPriority -- an integer from 0 to 99 + Status -- any valid status for Queue's Lifecycle, otherwises uses on_create from Lifecycle default + TimeEstimated -- an integer. estimated time for this task in minutes + TimeWorked -- an integer. time worked so far in minutes + TimeLeft -- an integer. time remaining in minutes + Starts -- an ISO date describing the ticket's start date and time in GMT + Due -- an ISO date describing the ticket's due date and time in GMT + MIMEObj -- a MIME::Entity object with the content of the initial ticket request. + CustomField-<n> -- a scalar or array of values for the customfield with the id <n> + +Ticket links can be set up during create by passing the link type as a hask key and +the ticket id to be linked to as a value (or a URI when linking to other objects). +Multiple links of the same type can be created by passing an array ref. For example: + + Parents => 45, + DependsOn => [ 15, 22 ], + RefersTo => 'http://www.bestpractical.com', + +Supported link types are C<MemberOf>, C<HasMember>, C<RefersTo>, C<ReferredToBy>, +C<DependsOn> and C<DependedOnBy>. Also, C<Parents> is alias for C<MemberOf> and +C<Members> and C<Children> are aliases for C<HasMember>. + +Returns: TICKETID, Transaction Object, Error Message + + +=cut + +sub Create { + my $self = shift; + + my %args = ( + id => undef, + EffectiveId => undef, + Queue => undef, + Requestor => undef, + Cc => undef, + AdminCc => undef, + SquelchMailTo => undef, + TransSquelchMailTo => undef, + Type => 'ticket', + Owner => undef, + Subject => '', + InitialPriority => undef, + FinalPriority => undef, + Priority => undef, + Status => undef, + TimeWorked => "0", + TimeLeft => 0, + TimeEstimated => 0, + Due => undef, + Starts => undef, + Started => undef, + Resolved => undef, + WillResolve => undef, + MIMEObj => undef, + _RecordTransaction => 1, + DryRun => 0, + @_ + ); + + my ($ErrStr, @non_fatal_errors); + + my $QueueObj = RT::Queue->new( RT->SystemUser ); + if ( ref $args{'Queue'} eq 'RT::Queue' ) { + $QueueObj->Load( $args{'Queue'}->Id ); + } + elsif ( $args{'Queue'} ) { + $QueueObj->Load( $args{'Queue'} ); + } + else { + $RT::Logger->debug("'". ( $args{'Queue'} ||''). "' not a recognised queue object." ); + } + + #Can't create a ticket without a queue. + unless ( $QueueObj->Id ) { + $RT::Logger->debug("$self No queue given for ticket creation."); + return ( 0, 0, $self->loc('Could not create ticket. Queue not set') ); + } + + + #Now that we have a queue, Check the ACLS + unless ( + $self->CurrentUser->HasRight( + Right => 'CreateTicket', + Object => $QueueObj + ) + ) + { + return ( + 0, 0, + $self->loc( "No permission to create tickets in the queue '[_1]'", $QueueObj->Name)); + } + + my $cycle = $QueueObj->Lifecycle; + unless ( defined $args{'Status'} && length $args{'Status'} ) { + $args{'Status'} = $cycle->DefaultOnCreate; + } + + $args{'Status'} = lc $args{'Status'}; + unless ( $cycle->IsValid( $args{'Status'} ) ) { + return ( 0, 0, + $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.", + $self->loc($args{'Status'})) + ); + } + + unless ( $cycle->IsTransition( '' => $args{'Status'} ) ) { + return ( 0, 0, + $self->loc("New tickets can not have status '[_1]' in this queue.", + $self->loc($args{'Status'})) + ); + } + + + + #Since we have a queue, we can set queue defaults + + #Initial Priority + # If there's no queue default initial priority and it's not set, set it to 0 + $args{'InitialPriority'} = $QueueObj->InitialPriority || 0 + unless defined $args{'InitialPriority'}; + + #Final priority + # If there's no queue default final priority and it's not set, set it to 0 + $args{'FinalPriority'} = $QueueObj->FinalPriority || 0 + unless defined $args{'FinalPriority'}; + + # Priority may have changed from InitialPriority, for the case + # where we're importing tickets (eg, from an older RT version.) + $args{'Priority'} = $args{'InitialPriority'} + unless defined $args{'Priority'}; + + # Dates + #TODO we should see what sort of due date we're getting, rather + + # than assuming it's in ISO format. + + #Set the due date. if we didn't get fed one, use the queue default due in + my $Due = RT::Date->new( $self->CurrentUser ); + if ( defined $args{'Due'} ) { + $Due->Set( Format => 'ISO', Value => $args{'Due'} ); + } + elsif ( my $due_in = $QueueObj->DefaultDueIn ) { + $Due->SetToNow; + $Due->AddDays( $due_in ); + } + + my $Starts = RT::Date->new( $self->CurrentUser ); + if ( defined $args{'Starts'} ) { + $Starts->Set( Format => 'ISO', Value => $args{'Starts'} ); + } + + my $Started = RT::Date->new( $self->CurrentUser ); + if ( defined $args{'Started'} ) { + $Started->Set( Format => 'ISO', Value => $args{'Started'} ); + } + + my $WillResolve = RT::Date->new($self->CurrentUser ); + if ( defined $args{'WillResolve'} ) { + $WillResolve->Set( Format => 'ISO', Value => $args{'WillResolve'} ); + } + + # If the status is not an initial status, set the started date + elsif ( !$cycle->IsInitial($args{'Status'}) ) { + $Started->SetToNow; + } + + my $Resolved = RT::Date->new( $self->CurrentUser ); + if ( defined $args{'Resolved'} ) { + $Resolved->Set( Format => 'ISO', Value => $args{'Resolved'} ); + } + + #If the status is an inactive status, set the resolved date + elsif ( $cycle->IsInactive( $args{'Status'} ) ) + { + $RT::Logger->debug( "Got a ". $args{'Status'} + ."(inactive) ticket with undefined resolved date. Setting to now." + ); + $Resolved->SetToNow; + } + + # }}} + + # Dealing with time fields + + $args{'TimeEstimated'} = 0 unless defined $args{'TimeEstimated'}; + $args{'TimeWorked'} = 0 unless defined $args{'TimeWorked'}; + $args{'TimeLeft'} = 0 unless defined $args{'TimeLeft'}; + + # }}} + + # Deal with setting the owner + + my $Owner; + if ( ref( $args{'Owner'} ) eq 'RT::User' ) { + if ( $args{'Owner'}->id ) { + $Owner = $args{'Owner'}; + } else { + $RT::Logger->error('Passed an empty RT::User for owner'); + push @non_fatal_errors, + $self->loc("Owner could not be set.") . " ". + $self->loc("Invalid value for [_1]",loc('owner')); + $Owner = undef; + } + } + + #If we've been handed something else, try to load the user. + elsif ( $args{'Owner'} ) { + $Owner = RT::User->new( $self->CurrentUser ); + $Owner->Load( $args{'Owner'} ); + if (!$Owner->id) { + $Owner->LoadByEmail( $args{'Owner'} ) + } + unless ( $Owner->Id ) { + push @non_fatal_errors, + $self->loc("Owner could not be set.") . " " + . $self->loc( "User '[_1]' could not be found.", $args{'Owner'} ); + $Owner = undef; + } + } + + #If we have a proposed owner and they don't have the right + #to own a ticket, scream about it and make them not the owner + + my $DeferOwner; + if ( $Owner && $Owner->Id != RT->Nobody->Id + && !$Owner->HasRight( Object => $QueueObj, Right => 'OwnTicket' ) ) + { + $DeferOwner = $Owner; + $Owner = undef; + $RT::Logger->debug('going to deffer setting owner'); + + } + + #If we haven't been handed a valid owner, make it nobody. + unless ( defined($Owner) && $Owner->Id ) { + $Owner = RT::User->new( $self->CurrentUser ); + $Owner->Load( RT->Nobody->Id ); + } + + # }}} + +# We attempt to load or create each of the people who might have a role for this ticket +# _outside_ the transaction, so we don't get into ticket creation races + foreach my $type ( "Cc", "AdminCc", "Requestor" ) { + $args{ $type } = [ $args{ $type } ] unless ref $args{ $type }; + foreach my $watcher ( splice @{ $args{$type} } ) { + next unless $watcher; + if ( $watcher =~ /^\d+$/ ) { + push @{ $args{$type} }, $watcher; + } else { + my @addresses = RT::EmailParser->ParseEmailAddress( $watcher ); + foreach my $address( @addresses ) { + my $user = RT::User->new( RT->SystemUser ); + my ($uid, $msg) = $user->LoadOrCreateByEmail( $address ); + unless ( $uid ) { + push @non_fatal_errors, + $self->loc("Couldn't load or create user: [_1]", $msg); + } else { + push @{ $args{$type} }, $user->id; + } + } + } + } + } + + $args{'Type'} = lc $args{'Type'} + if $args{'Type'} =~ /^(ticket|approval|reminder)$/i; + + $args{'Subject'} =~ s/\n//g; + + $RT::Handle->BeginTransaction(); + + my %params = ( + Queue => $QueueObj->Id, + Owner => $Owner->Id, + Subject => $args{'Subject'}, + InitialPriority => $args{'InitialPriority'}, + FinalPriority => $args{'FinalPriority'}, + Priority => $args{'Priority'}, + Status => $args{'Status'}, + TimeWorked => $args{'TimeWorked'}, + TimeEstimated => $args{'TimeEstimated'}, + TimeLeft => $args{'TimeLeft'}, + Type => $args{'Type'}, + Starts => $Starts->ISO, + Started => $Started->ISO, + Resolved => $Resolved->ISO, + WillResolve => $WillResolve->ISO, + Due => $Due->ISO + ); + +# Parameters passed in during an import that we probably don't want to touch, otherwise + foreach my $attr (qw(id Creator Created LastUpdated LastUpdatedBy)) { + $params{$attr} = $args{$attr} if $args{$attr}; + } + + # Delete null integer parameters + foreach my $attr + (qw(TimeWorked TimeLeft TimeEstimated InitialPriority FinalPriority)) + { + delete $params{$attr} + unless ( exists $params{$attr} && $params{$attr} ); + } + + # Delete the time worked if we're counting it in the transaction + delete $params{'TimeWorked'} if $args{'_RecordTransaction'}; + + my ($id,$ticket_message) = $self->SUPER::Create( %params ); + unless ($id) { + $RT::Logger->crit( "Couldn't create a ticket: " . $ticket_message ); + $RT::Handle->Rollback(); + return ( 0, 0, + $self->loc("Ticket could not be created due to an internal error") + ); + } + + #Set the ticket's effective ID now that we've created it. + my ( $val, $msg ) = $self->__Set( + Field => 'EffectiveId', + Value => ( $args{'EffectiveId'} || $id ) + ); + unless ( $val ) { + $RT::Logger->crit("Couldn't set EffectiveId: $msg"); + $RT::Handle->Rollback; + return ( 0, 0, + $self->loc("Ticket could not be created due to an internal error") + ); + } + + my $create_groups_ret = $self->_CreateTicketGroups(); + unless ($create_groups_ret) { + $RT::Logger->crit( "Couldn't create ticket groups for ticket " + . $self->Id + . ". aborting Ticket creation." ); + $RT::Handle->Rollback(); + return ( 0, 0, + $self->loc("Ticket could not be created due to an internal error") + ); + } + + # Set the owner in the Groups table + # We denormalize it into the Ticket table too because doing otherwise would + # kill performance, bigtime. It gets kept in lockstep thanks to the magic of transactionalization + $self->OwnerGroup->_AddMember( + PrincipalId => $Owner->PrincipalId, + InsideTransaction => 1 + ) unless $DeferOwner; + + + + # Deal with setting up watchers + + foreach my $type ( "Cc", "AdminCc", "Requestor" ) { + # we know it's an array ref + foreach my $watcher ( @{ $args{$type} } ) { + + # Note that we're using AddWatcher, rather than _AddWatcher, as we + # actually _want_ that ACL check. Otherwise, random ticket creators + # could make themselves adminccs and maybe get ticket rights. that would + # be poor + my $method = $type eq 'AdminCc'? 'AddWatcher': '_AddWatcher'; + + my ($val, $msg) = $self->$method( + Type => $type, + PrincipalId => $watcher, + Silent => 1, + ); + push @non_fatal_errors, $self->loc("Couldn't set [_1] watcher: [_2]", $type, $msg) + unless $val; + } + } + + if ($args{'SquelchMailTo'}) { + my @squelch = ref( $args{'SquelchMailTo'} ) ? @{ $args{'SquelchMailTo'} } + : $args{'SquelchMailTo'}; + $self->_SquelchMailTo( @squelch ); + } + + + # }}} + + # Add all the custom fields + + foreach my $arg ( keys %args ) { + next unless $arg =~ /^CustomField-(\d+)$/i; + my $cfid = $1; + + foreach my $value ( + UNIVERSAL::isa( $args{$arg} => 'ARRAY' ) ? @{ $args{$arg} } : ( $args{$arg} ) ) + { + next unless defined $value && length $value; + + # Allow passing in uploaded LargeContent etc by hash reference + my ($status, $msg) = $self->_AddCustomFieldValue( + (UNIVERSAL::isa( $value => 'HASH' ) + ? %$value + : (Value => $value) + ), + Field => $cfid, + RecordTransaction => 0, + ); + push @non_fatal_errors, $msg unless $status; + } + } + + # }}} + + # Deal with setting up links + + # TODO: Adding link may fire scrips on other end and those scrips + # could create transactions on this ticket before 'Create' transaction. + # + # We should implement different lifecycle: record 'Create' transaction, + # create links and only then fire create transaction's scrips. + # + # Ideal variant: add all links without firing scrips, record create + # transaction and only then fire scrips on the other ends of links. + # + # //RUZ + + foreach my $type ( keys %LINKTYPEMAP ) { + next unless ( defined $args{$type} ); + foreach my $link ( + ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) + { + my ( $val, $msg, $obj ) = $self->__GetTicketFromURI( URI => $link ); + unless ($val) { + push @non_fatal_errors, $msg; + next; + } + + # Check rights on the other end of the link if we must + # then run _AddLink that doesn't check for ACLs + if ( RT->Config->Get( 'StrictLinkACL' ) ) { + if ( $obj && !$obj->CurrentUserHasRight('ModifyTicket') ) { + push @non_fatal_errors, $self->loc('Linking. Permission denied'); + next; + } + } + + if ( $obj && lc $obj->Status eq 'deleted' ) { + push @non_fatal_errors, + $self->loc("Linking. Can't link to a deleted ticket"); + next; + } + + my ( $wval, $wmsg ) = $self->_AddLink( + Type => $LINKTYPEMAP{$type}->{'Type'}, + $LINKTYPEMAP{$type}->{'Mode'} => $link, + Silent => !$args{'_RecordTransaction'} || $self->Type eq 'reminder', + 'Silent'. ( $LINKTYPEMAP{$type}->{'Mode'} eq 'Base'? 'Target': 'Base' ) + => 1, + ); + + push @non_fatal_errors, $wmsg unless ($wval); + } + } + + # }}} + + # {{{ Deal with auto-customer association + + #unless we already have (a) customer(s)... + unless ( $self->Customers->Count ) { + + #first find any requestors with emails but *without* customer targets + my @NoCust_Requestors = + grep { $_->EmailAddress && ! $_->Customers->Count } + @{ $self->_Requestors->UserMembersObj->ItemsArrayRef }; + + for my $Requestor (@NoCust_Requestors) { + + #perhaps the stuff in here should be in a User method?? + my @Customers = + &RT::URI::freeside::email_search( email=>$Requestor->EmailAddress ); + + foreach my $custnum ( map $_->{'custnum'}, @Customers ) { + + ## false laziness w/RT/Interface/Web_Vendor.pm + my @link = ( 'Type' => 'MemberOf', + 'Target' => "freeside://freeside/cust_main/$custnum", + ); + + my( $val, $msg ) = $Requestor->_AddLink(@link); + #XXX should do something with $msg# push @non_fatal_errors, $msg; + + } + + } + + #find any requestors with customer targets + + my %cust_target = (); + + my @Requestors = + grep { $_->Customers->Count } + @{ $self->_Requestors->UserMembersObj->ItemsArrayRef }; + + foreach my $Requestor ( @Requestors ) { + foreach my $cust_link ( @{ $Requestor->Customers->ItemsArrayRef } ) { + $cust_target{ $cust_link->Target } = 1; + } + } + + #and then auto-associate this ticket with those customers + + foreach my $cust_target ( keys %cust_target ) { + + my @link = ( 'Type' => 'MemberOf', + #'Target' => "freeside://freeside/cust_main/$custnum", + 'Target' => $cust_target, + ); + + my( $val, $msg ) = $self->_AddLink(@link); + push @non_fatal_errors, $msg; + + } + + } + + # }}} + + # Now that we've created the ticket and set up its metadata, we can actually go and check OwnTicket on the ticket itself. + # This might be different than before in cases where extensions like RTIR are doing clever things with RT's ACL system + if ( $DeferOwner ) { + if (!$DeferOwner->HasRight( Object => $self, Right => 'OwnTicket')) { + + $RT::Logger->warning( "User " . $DeferOwner->Name . "(" . $DeferOwner->id + . ") was proposed as a ticket owner but has no rights to own " + . "tickets in " . $QueueObj->Name ); + push @non_fatal_errors, $self->loc( + "Owner '[_1]' does not have rights to own this ticket.", + $DeferOwner->Name + ); + } else { + $Owner = $DeferOwner; + $self->__Set(Field => 'Owner', Value => $Owner->id); + + } + $self->OwnerGroup->_AddMember( + PrincipalId => $Owner->PrincipalId, + InsideTransaction => 1 + ); + } + + #don't make a transaction or fire off any scrips for reminders either + if ( $args{'_RecordTransaction'} && $self->Type ne 'reminder' ) { + + # Add a transaction for the create + my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( + Type => "Create", + TimeTaken => $args{'TimeWorked'}, + MIMEObj => $args{'MIMEObj'}, + CommitScrips => !$args{'DryRun'}, + SquelchMailTo => $args{'TransSquelchMailTo'}, + ); + + if ( $self->Id && $Trans ) { + + #$TransObj->UpdateCustomFields(ARGSRef => \%args); + $TransObj->UpdateCustomFields(%args); + + $RT::Logger->info( "Ticket " . $self->Id . " created in queue '" . $QueueObj->Name . "' by " . $self->CurrentUser->Name ); + $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name ); + $ErrStr = join( "\n", $ErrStr, @non_fatal_errors ); + } + else { + $RT::Handle->Rollback(); + + $ErrStr = join( "\n", $ErrStr, @non_fatal_errors ); + $RT::Logger->error("Ticket couldn't be created: $ErrStr"); + return ( 0, 0, $self->loc( "Ticket could not be created due to an internal error")); + } + + if ( $args{'DryRun'} ) { + $RT::Handle->Rollback(); + return ($self->id, $TransObj, $ErrStr); + } + $RT::Handle->Commit(); + return ( $self->Id, $TransObj->Id, $ErrStr ); + + # }}} + } + else { + + # Not going to record a transaction + $RT::Handle->Commit(); + $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name ); + $ErrStr = join( "\n", $ErrStr, @non_fatal_errors ); + return ( $self->Id, 0, $ErrStr ); + + } +} + +sub SetType { + my $self = shift; + my $value = shift; + + # Force lowercase on internal RT types + $value = lc $value + if $value =~ /^(ticket|approval|reminder)$/i; + return $self->_Set(Field => 'Type', Value => $value, @_); +} + + + +=head2 _Parse822HeadersForAttributes Content + +Takes an RFC822 style message and parses its attributes into a hash. + +=cut + +sub _Parse822HeadersForAttributes { + my $self = shift; + my $content = shift; + my %args; + + my @lines = ( split ( /\n/, $content ) ); + while ( defined( my $line = shift @lines ) ) { + if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) { + my $value = $2; + my $tag = lc($1); + + $tag =~ s/-//g; + if ( defined( $args{$tag} ) ) + { #if we're about to get a second value, make it an array + $args{$tag} = [ $args{$tag} ]; + } + if ( ref( $args{$tag} ) ) + { #If it's an array, we want to push the value + push @{ $args{$tag} }, $value; + } + else { #if there's nothing there, just set the value + $args{$tag} = $value; + } + } elsif ($line =~ /^$/) { + + #TODO: this won't work, since "" isn't of the form "foo:value" + + while ( defined( my $l = shift @lines ) ) { + push @{ $args{'content'} }, $l; + } + } + + } + + foreach my $date (qw(due starts started resolved)) { + my $dateobj = RT::Date->new(RT->SystemUser); + if ( defined ($args{$date}) and $args{$date} =~ /^\d+$/ ) { + $dateobj->Set( Format => 'unix', Value => $args{$date} ); + } + else { + $dateobj->Set( Format => 'unknown', Value => $args{$date} ); + } + $args{$date} = $dateobj->ISO; + } + $args{'mimeobj'} = MIME::Entity->new(); + $args{'mimeobj'}->build( + Type => ( $args{'contenttype'} || 'text/plain' ), + Data => ($args{'content'} || '') + ); + + return (%args); +} + + + +=head2 Import PARAMHASH + +Import a ticket. +Doesn't create a transaction. +Doesn't supply queue defaults, etc. + +Returns: TICKETID + +=cut + +sub Import { + my $self = shift; + my ( $ErrStr, $QueueObj, $Owner ); + + my %args = ( + id => undef, + EffectiveId => undef, + Queue => undef, + Requestor => undef, + Type => 'ticket', + Owner => RT->Nobody->Id, + Subject => '[no subject]', + InitialPriority => undef, + FinalPriority => undef, + Status => 'new', + TimeWorked => "0", + Due => undef, + Created => undef, + Updated => undef, + Resolved => undef, + Told => undef, + @_ + ); + + if ( ( defined( $args{'Queue'} ) ) && ( !ref( $args{'Queue'} ) ) ) { + $QueueObj = RT::Queue->new(RT->SystemUser); + $QueueObj->Load( $args{'Queue'} ); + + #TODO error check this and return 0 if it's not loading properly +++ + } + elsif ( ref( $args{'Queue'} ) eq 'RT::Queue' ) { + $QueueObj = RT::Queue->new(RT->SystemUser); + $QueueObj->Load( $args{'Queue'}->Id ); + } + else { + $RT::Logger->debug( + "$self " . $args{'Queue'} . " not a recognised queue object." ); + } + + #Can't create a ticket without a queue. + unless ( defined($QueueObj) and $QueueObj->Id ) { + $RT::Logger->debug("$self No queue given for ticket creation."); + return ( 0, $self->loc('Could not create ticket. Queue not set') ); + } + + #Now that we have a queue, Check the ACLS + unless ( + $self->CurrentUser->HasRight( + Right => 'CreateTicket', + Object => $QueueObj + ) + ) + { + return ( 0, + $self->loc("No permission to create tickets in the queue '[_1]'" + , $QueueObj->Name)); + } + + # Deal with setting the owner + + # Attempt to take user object, user name or user id. + # Assign to nobody if lookup fails. + if ( defined( $args{'Owner'} ) ) { + if ( ref( $args{'Owner'} ) ) { + $Owner = $args{'Owner'}; + } + else { + $Owner = RT::User->new( $self->CurrentUser ); + $Owner->Load( $args{'Owner'} ); + if ( !defined( $Owner->id ) ) { + $Owner->Load( RT->Nobody->id ); + } + } + } + + #If we have a proposed owner and they don't have the right + #to own a ticket, scream about it and make them not the owner + if ( + ( defined($Owner) ) + and ( $Owner->Id != RT->Nobody->Id ) + and ( + !$Owner->HasRight( + Object => $QueueObj, + Right => 'OwnTicket' + ) + ) + ) + { + + $RT::Logger->warning( "$self user " + . $Owner->Name . "(" + . $Owner->id + . ") was proposed " + . "as a ticket owner but has no rights to own " + . "tickets in '" + . $QueueObj->Name . "'" ); + + $Owner = undef; + } + + #If we haven't been handed a valid owner, make it nobody. + unless ( defined($Owner) ) { + $Owner = RT::User->new( $self->CurrentUser ); + $Owner->Load( RT->Nobody->UserObj->Id ); + } + + # }}} + + unless ( $self->ValidateStatus( $args{'Status'} ) ) { + return ( 0, $self->loc("'[_1]' is an invalid value for status", $args{'Status'}) ); + } + + $self->{'_AccessibleCache'}{Created} = { 'read' => 1, 'write' => 1 }; + $self->{'_AccessibleCache'}{Creator} = { 'read' => 1, 'auto' => 1 }; + $self->{'_AccessibleCache'}{LastUpdated} = { 'read' => 1, 'write' => 1 }; + $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read' => 1, 'auto' => 1 }; + + # If we're coming in with an id, set that now. + my $EffectiveId = undef; + if ( $args{'id'} ) { + $EffectiveId = $args{'id'}; + + } + + my $id = $self->SUPER::Create( + id => $args{'id'}, + EffectiveId => $EffectiveId, + Queue => $QueueObj->Id, + Owner => $Owner->Id, + Subject => $args{'Subject'}, # loc + InitialPriority => $args{'InitialPriority'}, # loc + FinalPriority => $args{'FinalPriority'}, # loc + Priority => $args{'InitialPriority'}, # loc + Status => $args{'Status'}, # loc + TimeWorked => $args{'TimeWorked'}, # loc + Type => $args{'Type'}, # loc + Created => $args{'Created'}, # loc + Told => $args{'Told'}, # loc + LastUpdated => $args{'Updated'}, # loc + Resolved => $args{'Resolved'}, # loc + Due => $args{'Due'}, # loc + ); + + # If the ticket didn't have an id + # Set the ticket's effective ID now that we've created it. + if ( $args{'id'} ) { + $self->Load( $args{'id'} ); + } + else { + my ( $val, $msg ) = + $self->__Set( Field => 'EffectiveId', Value => $id ); + + unless ($val) { + $RT::Logger->err( + $self . "->Import couldn't set EffectiveId: $msg" ); + } + } + + my $create_groups_ret = $self->_CreateTicketGroups(); + unless ($create_groups_ret) { + $RT::Logger->crit( + "Couldn't create ticket groups for ticket " . $self->Id ); + } + + $self->OwnerGroup->_AddMember( PrincipalId => $Owner->PrincipalId ); + + foreach my $watcher ( @{ $args{'Cc'} } ) { + $self->_AddWatcher( Type => 'Cc', Email => $watcher, Silent => 1 ); + } + foreach my $watcher ( @{ $args{'AdminCc'} } ) { + $self->_AddWatcher( Type => 'AdminCc', Email => $watcher, + Silent => 1 ); + } + foreach my $watcher ( @{ $args{'Requestor'} } ) { + $self->_AddWatcher( Type => 'Requestor', Email => $watcher, + Silent => 1 ); + } + + return ( $self->Id, $ErrStr ); +} + + + + +=head2 _CreateTicketGroups + +Create the ticket groups and links for this ticket. +This routine expects to be called from Ticket->Create _inside of a transaction_ + +It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner. + +It will return true on success and undef on failure. + + +=cut + + +sub _CreateTicketGroups { + my $self = shift; + + my @types = (qw(Requestor Owner Cc AdminCc)); + + foreach my $type (@types) { + my $type_obj = RT::Group->new($self->CurrentUser); + my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role', + Instance => $self->Id, + Type => $type); + unless ($id) { + $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ". + $self->Id.": ".$msg); + return(undef); + } + } + return(1); + +} + + + +=head2 OwnerGroup + +A constructor which returns an RT::Group object containing the owner of this ticket. + +=cut + +sub OwnerGroup { + my $self = shift; + my $owner_obj = RT::Group->new($self->CurrentUser); + $owner_obj->LoadTicketRoleGroup( Ticket => $self->Id, Type => 'Owner'); + return ($owner_obj); +} + + + + +=head2 AddWatcher + +AddWatcher takes a parameter hash. The keys are as follows: + +Type One of Requestor, Cc, AdminCc + +PrincipalId The RT::Principal id of the user or group that's being added as a watcher + +Email The email address of the new watcher. If a user with this + email address can't be found, a new nonprivileged user will be created. + +If the watcher you're trying to set has an RT account, set the PrincipalId paremeter to their User Id. Otherwise, set the Email parameter to their Email address. + +=cut + +sub AddWatcher { + my $self = shift; + my %args = ( + Type => undef, + PrincipalId => undef, + Email => undef, + @_ + ); + + # ModifyTicket works in any case + return $self->_AddWatcher( %args ) + if $self->CurrentUserHasRight('ModifyTicket'); + if ( $args{'Email'} ) { + my ($addr) = RT::EmailParser->ParseEmailAddress( $args{'Email'} ); + return (0, $self->loc("Couldn't parse address from '[_1]' string", $args{'Email'} )) + unless $addr; + + if ( lc $self->CurrentUser->EmailAddress + eq lc RT::User->CanonicalizeEmailAddress( $addr->address ) ) + { + $args{'PrincipalId'} = $self->CurrentUser->id; + delete $args{'Email'}; + } + } + + # If the watcher isn't the current user then the current user has no right + # bail + unless ( $args{'PrincipalId'} && $self->CurrentUser->id == $args{'PrincipalId'} ) { + return ( 0, $self->loc("Permission Denied") ); + } + + # If it's an AdminCc and they don't have 'WatchAsAdminCc', bail + if ( $args{'Type'} eq 'AdminCc' ) { + unless ( $self->CurrentUserHasRight('WatchAsAdminCc') ) { + return ( 0, $self->loc('Permission Denied') ); + } + } + + # If it's a Requestor or Cc and they don't have 'Watch', bail + elsif ( $args{'Type'} eq 'Cc' || $args{'Type'} eq 'Requestor' ) { + unless ( $self->CurrentUserHasRight('Watch') ) { + return ( 0, $self->loc('Permission Denied') ); + } + } + else { + $RT::Logger->warning( "AddWatcher got passed a bogus type"); + return ( 0, $self->loc('Error in parameters to Ticket->AddWatcher') ); + } + + return $self->_AddWatcher( %args ); +} + +#This contains the meat of AddWatcher. but can be called from a routine like +# Create, which doesn't need the additional acl check +sub _AddWatcher { + my $self = shift; + my %args = ( + Type => undef, + Silent => undef, + PrincipalId => undef, + Email => undef, + @_ + ); + + + my $principal = RT::Principal->new($self->CurrentUser); + if ($args{'Email'}) { + if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) { + return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $args{'Email'}, $self->loc($args{'Type'}))); + } + my $user = RT::User->new(RT->SystemUser); + my ($pid, $msg) = $user->LoadOrCreateByEmail( $args{'Email'} ); + $args{'PrincipalId'} = $pid if $pid; + } + if ($args{'PrincipalId'}) { + $principal->Load($args{'PrincipalId'}); + if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) { + return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email, $self->loc($args{'Type'}))) + if RT::EmailParser->IsRTAddress( $email ); + + } + } + + + # If we can't find this watcher, we need to bail. + unless ($principal->Id) { + $RT::Logger->error("Could not load create a user with the email address '".$args{'Email'}. "' to add as a watcher for ticket ".$self->Id); + return(0, $self->loc("Could not find or create that user")); + } + + + my $group = RT::Group->new($self->CurrentUser); + $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->Id); + unless ($group->id) { + return(0,$self->loc("Group not found")); + } + + if ( $group->HasMember( $principal)) { + + return ( 0, $self->loc('[_1] is already a [_2] for this ticket', + $principal->Object->Name, $self->loc($args{'Type'})) ); + } + + + my ( $m_id, $m_msg ) = $group->_AddMember( PrincipalId => $principal->Id, + InsideTransaction => 1 ); + unless ($m_id) { + $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg); + + return ( 0, $self->loc('Could not make [_1] a [_2] for this ticket', + $principal->Object->Name, $self->loc($args{'Type'})) ); + } + + unless ( $args{'Silent'} ) { + $self->_NewTransaction( + Type => 'AddWatcher', + NewValue => $principal->Id, + Field => $args{'Type'} + ); + } + + return ( 1, $self->loc('Added [_1] as a [_2] for this ticket', + $principal->Object->Name, $self->loc($args{'Type'})) ); +} + + + + +=head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS } + + +Deletes a Ticket watcher. Takes two arguments: + +Type (one of Requestor,Cc,AdminCc) + +and one of + +PrincipalId (an RT::Principal Id of the watcher you want to remove) + OR +Email (the email address of an existing wathcer) + + +=cut + + +sub DeleteWatcher { + my $self = shift; + + my %args = ( Type => undef, + PrincipalId => undef, + Email => undef, + @_ ); + + unless ( $args{'PrincipalId'} || $args{'Email'} ) { + return ( 0, $self->loc("No principal specified") ); + } + my $principal = RT::Principal->new( $self->CurrentUser ); + if ( $args{'PrincipalId'} ) { + + $principal->Load( $args{'PrincipalId'} ); + } + else { + my $user = RT::User->new( $self->CurrentUser ); + $user->LoadByEmail( $args{'Email'} ); + $principal->Load( $user->Id ); + } + + # If we can't find this watcher, we need to bail. + unless ( $principal->Id ) { + return ( 0, $self->loc("Could not find that principal") ); + } + + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadTicketRoleGroup( Type => $args{'Type'}, Ticket => $self->Id ); + unless ( $group->id ) { + return ( 0, $self->loc("Group not found") ); + } + + # Check ACLS + #If the watcher we're trying to add is for the current user + if ( $self->CurrentUser->PrincipalId == $principal->id ) { + + # If it's an AdminCc and they don't have + # 'WatchAsAdminCc' or 'ModifyTicket', bail + if ( $args{'Type'} eq 'AdminCc' ) { + unless ( $self->CurrentUserHasRight('ModifyTicket') + or $self->CurrentUserHasRight('WatchAsAdminCc') ) { + return ( 0, $self->loc('Permission Denied') ); + } + } + + # If it's a Requestor or Cc and they don't have + # 'Watch' or 'ModifyTicket', bail + elsif ( ( $args{'Type'} eq 'Cc' ) or ( $args{'Type'} eq 'Requestor' ) ) + { + unless ( $self->CurrentUserHasRight('ModifyTicket') + or $self->CurrentUserHasRight('Watch') ) { + return ( 0, $self->loc('Permission Denied') ); + } + } + else { + $RT::Logger->warning("$self -> DeleteWatcher got passed a bogus type"); + return ( 0, + $self->loc('Error in parameters to Ticket->DeleteWatcher') ); + } + } + + # If the watcher isn't the current user + # and the current user doesn't have 'ModifyTicket' bail + else { + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + } + + # }}} + + # see if this user is already a watcher. + + unless ( $group->HasMember($principal) ) { + return ( 0, + $self->loc( '[_1] is not a [_2] for this ticket', + $principal->Object->Name, $args{'Type'} ) ); + } + + my ( $m_id, $m_msg ) = $group->_DeleteMember( $principal->Id ); + unless ($m_id) { + $RT::Logger->error( "Failed to delete " + . $principal->Id + . " as a member of group " + . $group->Id . ": " + . $m_msg ); + + return (0, + $self->loc( + 'Could not remove [_1] as a [_2] for this ticket', + $principal->Object->Name, $args{'Type'} ) ); + } + + unless ( $args{'Silent'} ) { + $self->_NewTransaction( Type => 'DelWatcher', + OldValue => $principal->Id, + Field => $args{'Type'} ); + } + + return ( 1, + $self->loc( "[_1] is no longer a [_2] for this ticket.", + $principal->Object->Name, + $args{'Type'} ) ); +} + + + + + +=head2 SquelchMailTo [EMAIL] + +Takes an optional email address to never email about updates to this ticket. + + +Returns an array of the RT::Attribute objects for this ticket's 'SquelchMailTo' attributes. + + +=cut + +sub SquelchMailTo { + my $self = shift; + if (@_) { + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return (); + } + } else { + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + return (); + } + + } + return $self->_SquelchMailTo(@_); +} + +sub _SquelchMailTo { + my $self = shift; + if (@_) { + my $attr = shift; + $self->AddAttribute( Name => 'SquelchMailTo', Content => $attr ) + unless grep { $_->Content eq $attr } + $self->Attributes->Named('SquelchMailTo'); + } + my @attributes = $self->Attributes->Named('SquelchMailTo'); + return (@attributes); +} + + +=head2 UnsquelchMailTo ADDRESS + +Takes an address and removes it from this ticket's "SquelchMailTo" list. If an address appears multiple times, each instance is removed. + +Returns a tuple of (status, message) + +=cut + +sub UnsquelchMailTo { + my $self = shift; + + my $address = shift; + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + my ($val, $msg) = $self->Attributes->DeleteEntry ( Name => 'SquelchMailTo', Content => $address); + return ($val, $msg); +} + + + +=head2 RequestorAddresses + +B<Returns> String: All Ticket Requestor email addresses as a string. + +=cut + +sub RequestorAddresses { + my $self = shift; + + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + return undef; + } + + return ( $self->Requestors->MemberEmailAddressesAsString ); +} + + +=head2 AdminCcAddresses + +returns String: All Ticket AdminCc email addresses as a string + +=cut + +sub AdminCcAddresses { + my $self = shift; + + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + return undef; + } + + return ( $self->AdminCc->MemberEmailAddressesAsString ) + +} + +=head2 CcAddresses + +returns String: All Ticket Ccs as a string of email addresses + +=cut + +sub CcAddresses { + my $self = shift; + + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + return undef; + } + return ( $self->Cc->MemberEmailAddressesAsString); + +} + + + + +=head2 Requestors + +Takes nothing. +Returns this ticket's Requestors as an RT::Group object + +=cut + +sub Requestors { + my $self = shift; + + my $group = RT::Group->new($self->CurrentUser); + if ( $self->CurrentUserHasRight('ShowTicket') ) { + $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id); + } + return ($group); + +} + +=head2 _Requestors + +Private non-ACLed variant of Reqeustors so that we can look them up for the +purposes of customer auto-association during create. + +=cut + +sub _Requestors { + my $self = shift; + + my $group = RT::Group->new($RT::SystemUser); + $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id); + return ($group); +} + +=head2 Cc + +Takes nothing. +Returns an RT::Group object which contains this ticket's Ccs. +If the user doesn't have "ShowTicket" permission, returns an empty group + +=cut + +sub Cc { + my $self = shift; + + my $group = RT::Group->new($self->CurrentUser); + if ( $self->CurrentUserHasRight('ShowTicket') ) { + $group->LoadTicketRoleGroup(Type => 'Cc', Ticket => $self->Id); + } + return ($group); + +} + + + +=head2 AdminCc + +Takes nothing. +Returns an RT::Group object which contains this ticket's AdminCcs. +If the user doesn't have "ShowTicket" permission, returns an empty group + +=cut + +sub AdminCc { + my $self = shift; + + my $group = RT::Group->new($self->CurrentUser); + if ( $self->CurrentUserHasRight('ShowTicket') ) { + $group->LoadTicketRoleGroup(Type => 'AdminCc', Ticket => $self->Id); + } + return ($group); + +} + + + + +# a generic routine to be called by IsRequestor, IsCc and IsAdminCc + +=head2 IsWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL } + +Takes a param hash with the attributes Type and either PrincipalId or Email + +Type is one of Requestor, Cc, AdminCc and Owner + +PrincipalId is an RT::Principal id, and Email is an email address. + +Returns true if the specified principal (or the one corresponding to the +specified address) is a member of the group Type for this ticket. + +XX TODO: This should be Memoized. + +=cut + +sub IsWatcher { + my $self = shift; + + my %args = ( Type => 'Requestor', + PrincipalId => undef, + Email => undef, + @_ + ); + + # Load the relevant group. + my $group = RT::Group->new($self->CurrentUser); + $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->id); + + # Find the relevant principal. + if (!$args{PrincipalId} && $args{Email}) { + # Look up the specified user. + my $user = RT::User->new($self->CurrentUser); + $user->LoadByEmail($args{Email}); + if ($user->Id) { + $args{PrincipalId} = $user->PrincipalId; + } + else { + # A non-existent user can't be a group member. + return 0; + } + } + + # Ask if it has the member in question + return $group->HasMember( $args{'PrincipalId'} ); +} + + + +=head2 IsRequestor PRINCIPAL_ID + +Takes an L<RT::Principal> id. + +Returns true if the principal is a requestor of the current ticket. + +=cut + +sub IsRequestor { + my $self = shift; + my $person = shift; + + return ( $self->IsWatcher( Type => 'Requestor', PrincipalId => $person ) ); + +}; + + + +=head2 IsCc PRINCIPAL_ID + + Takes an RT::Principal id. + Returns true if the principal is a Cc of the current ticket. + + +=cut + +sub IsCc { + my $self = shift; + my $cc = shift; + + return ( $self->IsWatcher( Type => 'Cc', PrincipalId => $cc ) ); + +} + + + +=head2 IsAdminCc PRINCIPAL_ID + + Takes an RT::Principal id. + Returns true if the principal is an AdminCc of the current ticket. + +=cut + +sub IsAdminCc { + my $self = shift; + my $person = shift; + + return ( $self->IsWatcher( Type => 'AdminCc', PrincipalId => $person ) ); + +} + + + +=head2 IsOwner + + Takes an RT::User object. Returns true if that user is this ticket's owner. +returns undef otherwise + +=cut + +sub IsOwner { + my $self = shift; + my $person = shift; + + # no ACL check since this is used in acl decisions + # unless ($self->CurrentUserHasRight('ShowTicket')) { + # return(undef); + # } + + #Tickets won't yet have owners when they're being created. + unless ( $self->OwnerObj->id ) { + return (undef); + } + + if ( $person->id == $self->OwnerObj->id ) { + return (1); + } + else { + return (undef); + } +} + + + + + +=head2 TransactionAddresses + +Returns a composite hashref of the results of L<RT::Transaction/Addresses> for +all this ticket's Create, Comment or Correspond transactions. The keys are +stringified email addresses. Each value is an L<Email::Address> object. + +NOTE: For performance reasons, this method might want to skip transactions and go straight for attachments. But to make that work right, we're going to need to go and walk around the access control in Attachment.pm's sub _Value. + +=cut + + +sub TransactionAddresses { + my $self = shift; + my $txns = $self->Transactions; + + my %addresses = (); + + my $attachments = RT::Attachments->new( $self->CurrentUser ); + $attachments->LimitByTicket( $self->id ); + $attachments->Columns( qw( id Headers TransactionId)); + + + foreach my $type (qw(Create Comment Correspond)) { + $attachments->Limit( ALIAS => $attachments->TransactionAlias, + FIELD => 'Type', + OPERATOR => '=', + VALUE => $type, + ENTRYAGGREGATOR => 'OR', + CASESENSITIVE => 1 + ); + } + + while ( my $att = $attachments->Next ) { + foreach my $addrlist ( values %{$att->Addresses } ) { + foreach my $addr (@$addrlist) { + +# Skip addresses without a phrase (things that are just raw addresses) if we have a phrase + next + if ( $addresses{ $addr->address } + && $addresses{ $addr->address }->phrase + && not $addr->phrase ); + + # skips "comment-only" addresses + next unless ( $addr->address ); + $addresses{ $addr->address } = $addr; + } + } + } + + return \%addresses; + +} + + + + + + +sub ValidateQueue { + my $self = shift; + my $Value = shift; + + if ( !$Value ) { + $RT::Logger->warning( " RT:::Queue::ValidateQueue called with a null value. this isn't ok."); + return (1); + } + + my $QueueObj = RT::Queue->new( $self->CurrentUser ); + my $id = $QueueObj->Load($Value); + + if ($id) { + return (1); + } + else { + return (undef); + } +} + + + +sub SetQueue { + my $self = shift; + my $NewQueue = shift; + + #Redundant. ACL gets checked in _Set; + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + my $NewQueueObj = RT::Queue->new( $self->CurrentUser ); + $NewQueueObj->Load($NewQueue); + + unless ( $NewQueueObj->Id() ) { + return ( 0, $self->loc("That queue does not exist") ); + } + + if ( $NewQueueObj->Id == $self->QueueObj->Id ) { + return ( 0, $self->loc('That is the same value') ); + } + unless ( $self->CurrentUser->HasRight( Right => 'CreateTicket', Object => $NewQueueObj)) { + return ( 0, $self->loc("You may not create requests in that queue.") ); + } + + my $new_status; + my $old_lifecycle = $self->QueueObj->Lifecycle; + my $new_lifecycle = $NewQueueObj->Lifecycle; + if ( $old_lifecycle->Name ne $new_lifecycle->Name ) { + unless ( $old_lifecycle->HasMoveMap( $new_lifecycle ) ) { + return ( 0, $self->loc("There is no mapping for statuses between these queues. Contact your system administrator.") ); + } + $new_status = $old_lifecycle->MoveMap( $new_lifecycle )->{ lc $self->Status }; + return ( 0, $self->loc("Mapping between queues' lifecycles is incomplete. Contact your system administrator.") ) + unless $new_status; + } + + if ( $new_status ) { + my $clone = RT::Ticket->new( RT->SystemUser ); + $clone->Load( $self->Id ); + unless ( $clone->Id ) { + return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) ); + } + + my $now = RT::Date->new( $self->CurrentUser ); + $now->SetToNow; + + my $old_status = $clone->Status; + + #If we're changing the status from initial in old to not intial in new, + # record that we've started + if ( $old_lifecycle->IsInitial($old_status) && !$new_lifecycle->IsInitial($new_status) && $clone->StartedObj->Unix == 0 ) { + #Set the Started time to "now" + $clone->_Set( + Field => 'Started', + Value => $now->ISO, + RecordTransaction => 0 + ); + } + + #When we close a ticket, set the 'Resolved' attribute to now. + # It's misnamed, but that's just historical. + if ( $new_lifecycle->IsInactive($new_status) ) { + $clone->_Set( + Field => 'Resolved', + Value => $now->ISO, + RecordTransaction => 0, + ); + } + + #Actually update the status + my ($val, $msg)= $clone->_Set( + Field => 'Status', + Value => $new_status, + RecordTransaction => 0, + ); + $RT::Logger->error( 'Status change failed on queue change: '. $msg ) + unless $val; + } + + my ($status, $msg) = $self->_Set( Field => 'Queue', Value => $NewQueueObj->Id() ); + + if ( $status ) { + # Clear the queue object cache; + $self->{_queue_obj} = undef; + + # Untake the ticket if we have no permissions in the new queue + unless ( $self->OwnerObj->HasRight( Right => 'OwnTicket', Object => $NewQueueObj ) ) { + my $clone = RT::Ticket->new( RT->SystemUser ); + $clone->Load( $self->Id ); + unless ( $clone->Id ) { + return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) ); + } + my ($status, $msg) = $clone->SetOwner( RT->Nobody->Id, 'Force' ); + $RT::Logger->error("Couldn't set owner on queue change: $msg") unless $status; + } + + # On queue change, change queue for reminders too + my $reminder_collection = $self->Reminders->Collection; + while ( my $reminder = $reminder_collection->Next ) { + my ($status, $msg) = $reminder->SetQueue($NewQueue); + $RT::Logger->error('Queue change failed for reminder #' . $reminder->Id . ': ' . $msg) unless $status; + } + } + + return ($status, $msg); +} + + + +=head2 QueueObj + +Takes nothing. returns this ticket's queue object + +=cut + +sub QueueObj { + my $self = shift; + + if(!$self->{_queue_obj} || ! $self->{_queue_obj}->id) { + + $self->{_queue_obj} = RT::Queue->new( $self->CurrentUser ); + + #We call __Value so that we can avoid the ACL decision and some deep recursion + my ($result) = $self->{_queue_obj}->Load( $self->__Value('Queue') ); + } + return ($self->{_queue_obj}); +} + +sub SetSubject { + my $self = shift; + my $value = shift; + $value =~ s/\n//g; + return $self->_Set( Field => 'Subject', Value => $value ); +} + +=head2 SubjectTag + +Takes nothing. Returns SubjectTag for this ticket. Includes +queue's subject tag or rtname if that is not set, ticket +id and braces, for example: + + [support.example.com #123456] + +=cut + +sub SubjectTag { + my $self = shift; + return + '[' + . ($self->QueueObj->SubjectTag || RT->Config->Get('rtname')) + .' #'. $self->id + .']' + ; +} + + +=head2 DueObj + + Returns an RT::Date object containing this ticket's due date + +=cut + +sub DueObj { + my $self = shift; + + my $time = RT::Date->new( $self->CurrentUser ); + + # -1 is RT::Date slang for never + if ( my $due = $self->Due ) { + $time->Set( Format => 'sql', Value => $due ); + } + else { + $time->Set( Format => 'unix', Value => -1 ); + } + + return $time; +} + + + +=head2 DueAsString + +Returns this ticket's due date as a human readable string + +=cut + +sub DueAsString { + my $self = shift; + return $self->DueObj->AsString(); +} + + + +=head2 ResolvedObj + + Returns an RT::Date object of this ticket's 'resolved' time. + +=cut + +sub ResolvedObj { + my $self = shift; + + my $time = RT::Date->new( $self->CurrentUser ); + $time->Set( Format => 'sql', Value => $self->Resolved ); + return $time; +} + + +=head2 FirstActiveStatus + +Returns the first active status that the ticket could transition to, +according to its current Queue's lifecycle. May return undef if there +is no such possible status to transition to, or we are already in it. +This is used in L<RT::Action::AutoOpen>, for instance. + +=cut + +sub FirstActiveStatus { + my $self = shift; + + my $lifecycle = $self->QueueObj->Lifecycle; + my $status = $self->Status; + my @active = $lifecycle->Active; + # no change if no active statuses in the lifecycle + return undef unless @active; + + # no change if the ticket is already has first status from the list of active + return undef if lc $status eq lc $active[0]; + + my ($next) = grep $lifecycle->IsActive($_), $lifecycle->Transitions($status); + return $next; +} + +=head2 FirstInactiveStatus + +Returns the first inactive status that the ticket could transition to, +according to its current Queue's lifecycle. May return undef if there +is no such possible status to transition to, or we are already in it. +This is used in resolve action in UnsafeEmailCommands, for instance. + +=cut + +sub FirstInactiveStatus { + my $self = shift; + + my $lifecycle = $self->QueueObj->Lifecycle; + my $status = $self->Status; + my @inactive = $lifecycle->Inactive; + # no change if no inactive statuses in the lifecycle + return undef unless @inactive; + + # no change if the ticket is already has first status from the list of inactive + return undef if lc $status eq lc $inactive[0]; + + my ($next) = grep $lifecycle->IsInactive($_), $lifecycle->Transitions($status); + return $next; +} + +=head2 SetStarted + +Takes a date in ISO format or undef +Returns a transaction id and a message +The client calls "Start" to note that the project was started on the date in $date. +A null date means "now" + +=cut + +sub SetStarted { + my $self = shift; + my $time = shift || 0; + + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + #We create a date object to catch date weirdness + my $time_obj = RT::Date->new( $self->CurrentUser() ); + if ( $time ) { + $time_obj->Set( Format => 'ISO', Value => $time ); + } + else { + $time_obj->SetToNow(); + } + + # We need $TicketAsSystem, in case the current user doesn't have + # ShowTicket + my $TicketAsSystem = RT::Ticket->new(RT->SystemUser); + $TicketAsSystem->Load( $self->Id ); + # Now that we're starting, open this ticket + # TODO: do we really want to force this as policy? it should be a scrip + my $next = $TicketAsSystem->FirstActiveStatus; + + $self->SetStatus( $next ) if defined $next; + + return ( $self->_Set( Field => 'Started', Value => $time_obj->ISO ) ); + +} + + + +=head2 StartedObj + + Returns an RT::Date object which contains this ticket's +'Started' time. + +=cut + +sub StartedObj { + my $self = shift; + + my $time = RT::Date->new( $self->CurrentUser ); + $time->Set( Format => 'sql', Value => $self->Started ); + return $time; +} + + + +=head2 StartsObj + + Returns an RT::Date object which contains this ticket's +'Starts' time. + +=cut + +sub StartsObj { + my $self = shift; + + my $time = RT::Date->new( $self->CurrentUser ); + $time->Set( Format => 'sql', Value => $self->Starts ); + return $time; +} + + + +=head2 ToldObj + + Returns an RT::Date object which contains this ticket's +'Told' time. + +=cut + +sub ToldObj { + my $self = shift; + + my $time = RT::Date->new( $self->CurrentUser ); + $time->Set( Format => 'sql', Value => $self->Told ); + return $time; +} + + + +=head2 ToldAsString + +A convenience method that returns ToldObj->AsString + +TODO: This should be deprecated + +=cut + +sub ToldAsString { + my $self = shift; + if ( $self->Told ) { + return $self->ToldObj->AsString(); + } + else { + return ("Never"); + } +} + + + +=head2 TimeWorkedAsString + +Returns the amount of time worked on this ticket as a Text String + +=cut + +sub TimeWorkedAsString { + my $self = shift; + my $value = $self->TimeWorked; + + # return the # of minutes worked turned into seconds and written as + # a simple text string, this is not really a date object, but if we + # diff a number of seconds vs the epoch, we'll get a nice description + # of time worked. + return "" unless $value; + return RT::Date->new( $self->CurrentUser ) + ->DurationAsString( $value * 60 ); +} + + + +=head2 TimeLeftAsString + +Returns the amount of time left on this ticket as a Text String + +=cut + +sub TimeLeftAsString { + my $self = shift; + my $value = $self->TimeLeft; + return "" unless $value; + return RT::Date->new( $self->CurrentUser ) + ->DurationAsString( $value * 60 ); +} + + + + +=head2 Comment + +Comment on this ticket. +Takes a hash with the following attributes: +If MIMEObj is undefined, Content will be used to build a MIME::Entity for this +comment. + +MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun + +If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed. +They will, however, be prepared and you'll be able to access them through the TransactionObj + +Returns: Transaction id, Error Message, Transaction Object +(note the different order from Create()!) + +=cut + +sub Comment { + my $self = shift; + + my %args = ( CcMessageTo => undef, + BccMessageTo => undef, + MIMEObj => undef, + Content => undef, + TimeTaken => 0, + DryRun => 0, + @_ ); + + unless ( ( $self->CurrentUserHasRight('CommentOnTicket') ) + or ( $self->CurrentUserHasRight('ModifyTicket') ) ) { + return ( 0, $self->loc("Permission Denied"), undef ); + } + $args{'NoteType'} = 'Comment'; + + $RT::Handle->BeginTransaction(); + if ($args{'DryRun'}) { + $args{'CommitScrips'} = 0; + } + + my @results = $self->_RecordNote(%args); + if ($args{'DryRun'}) { + $RT::Handle->Rollback(); + } else { + $RT::Handle->Commit(); + } + + return(@results); +} + + +=head2 Correspond + +Correspond on this ticket. +Takes a hashref with the following attributes: + + +MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun + +if there's no MIMEObj, Content is used to build a MIME::Entity object + +If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed. +They will, however, be prepared and you'll be able to access them through the TransactionObj + +Returns: Transaction id, Error Message, Transaction Object +(note the different order from Create()!) + + +=cut + +sub Correspond { + my $self = shift; + my %args = ( CcMessageTo => undef, + BccMessageTo => undef, + MIMEObj => undef, + Content => undef, + TimeTaken => 0, + @_ ); + + unless ( ( $self->CurrentUserHasRight('ReplyToTicket') ) + or ( $self->CurrentUserHasRight('ModifyTicket') ) ) { + return ( 0, $self->loc("Permission Denied"), undef ); + } + $args{'NoteType'} = 'Correspond'; + + $RT::Handle->BeginTransaction(); + if ($args{'DryRun'}) { + $args{'CommitScrips'} = 0; + } + + my @results = $self->_RecordNote(%args); + + unless ( $results[0] ) { + $RT::Handle->Rollback(); + return @results; + } + + #Set the last told date to now if this isn't mail from the requestor. + #TODO: Note that this will wrongly ack mail from any non-requestor as a "told" + unless ( $self->IsRequestor($self->CurrentUser->id) ) { + my %squelch; + $squelch{$_}++ for map {$_->Content} $self->SquelchMailTo, $results[2]->SquelchMailTo; + $self->_SetTold + if grep {not $squelch{$_}} $self->Requestors->MemberEmailAddresses; + } + + if ($args{'DryRun'}) { + $RT::Handle->Rollback(); + } else { + $RT::Handle->Commit(); + } + + return (@results); + +} + + + +=head2 _RecordNote + +the meat of both comment and correspond. + +Performs no access control checks. hence, dangerous. + +=cut + +sub _RecordNote { + my $self = shift; + my %args = ( + CcMessageTo => undef, + BccMessageTo => undef, + Encrypt => undef, + Sign => undef, + MIMEObj => undef, + Content => undef, + NoteType => 'Correspond', + TimeTaken => 0, + CommitScrips => 1, + SquelchMailTo => undef, + CustomFields => {}, + @_ + ); + + unless ( $args{'MIMEObj'} || $args{'Content'} ) { + return ( 0, $self->loc("No message attached"), undef ); + } + + unless ( $args{'MIMEObj'} ) { + $args{'MIMEObj'} = MIME::Entity->build( + Data => ( ref $args{'Content'}? $args{'Content'}: [ $args{'Content'} ] ) + ); + } + + $args{'MIMEObj'}->head->replace('X-RT-Interface' => 'API') + unless $args{'MIMEObj'}->head->get('X-RT-Interface'); + + # convert text parts into utf-8 + RT::I18N::SetMIMEEntityToUTF8( $args{'MIMEObj'} ); + + # If we've been passed in CcMessageTo and BccMessageTo fields, + # add them to the mime object for passing on to the transaction handler + # The "NotifyOtherRecipients" scripAction will look for RT-Send-Cc: and + # RT-Send-Bcc: headers + + + foreach my $type (qw/Cc Bcc/) { + if ( defined $args{ $type . 'MessageTo' } ) { + + my $addresses = join ', ', ( + map { RT::User->CanonicalizeEmailAddress( $_->address ) } + Email::Address->parse( $args{ $type . 'MessageTo' } ) ); + $args{'MIMEObj'}->head->replace( 'RT-Send-' . $type, Encode::encode_utf8( $addresses ) ); + } + } + + foreach my $argument (qw(Encrypt Sign)) { + $args{'MIMEObj'}->head->replace( + "X-RT-$argument" => Encode::encode_utf8( $args{ $argument } ) + ) if defined $args{ $argument }; + } + + # If this is from an external source, we need to come up with its + # internal Message-ID now, so all emails sent because of this + # message have a common Message-ID + my $org = RT->Config->Get('Organization'); + my $msgid = $args{'MIMEObj'}->head->get('Message-ID'); + unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) { + $args{'MIMEObj'}->head->set( + 'RT-Message-ID' => Encode::encode_utf8( + RT::Interface::Email::GenMessageId( Ticket => $self ) + ) + ); + } + + #Record the correspondence (write the transaction) + my ( $Trans, $msg, $TransObj ) = $self->_NewTransaction( + Type => $args{'NoteType'}, + Data => ( $args{'MIMEObj'}->head->get('subject') || 'No Subject' ), + TimeTaken => $args{'TimeTaken'}, + MIMEObj => $args{'MIMEObj'}, + CommitScrips => $args{'CommitScrips'}, + SquelchMailTo => $args{'SquelchMailTo'}, + CustomFields => $args{'CustomFields'}, + ); + + unless ($Trans) { + $RT::Logger->err("$self couldn't init a transaction $msg"); + return ( $Trans, $self->loc("Message could not be recorded"), undef ); + } + + return ( $Trans, $self->loc("Message recorded"), $TransObj ); +} + + +=head2 DryRun + +Builds a MIME object from the given C<UpdateSubject> and +C<UpdateContent>, then calls L</Comment> or L</Correspond> with +C<< DryRun => 1 >>, and returns the transaction so produced. + +=cut + +sub DryRun { + my $self = shift; + my %args = @_; + my $action; + if (($args{'UpdateType'} || $args{Action}) =~ /^respon(d|se)$/i ) { + $action = 'Correspond'; + } else { + $action = 'Comment'; + } + + my $Message = MIME::Entity->build( + Type => 'text/plain', + Subject => defined $args{UpdateSubject} ? Encode::encode_utf8( $args{UpdateSubject} ) : "", + Charset => 'UTF-8', + Data => $args{'UpdateContent'} || "", + ); + + my ( $Transaction, $Description, $Object ) = $self->$action( + CcMessageTo => $args{'UpdateCc'}, + BccMessageTo => $args{'UpdateBcc'}, + MIMEObj => $Message, + TimeTaken => $args{'UpdateTimeWorked'}, + DryRun => 1, + ); + unless ( $Transaction ) { + $RT::Logger->error("Couldn't fire '$action' action: $Description"); + } + + return $Object; +} + +=head2 DryRunCreate + +Prepares a MIME mesage with the given C<Subject>, C<Cc>, and +C<Content>, then calls L</Create> with C<< DryRun => 1 >> and returns +the resulting L<RT::Transaction>. + +=cut + +sub DryRunCreate { + my $self = shift; + my %args = @_; + my $Message = MIME::Entity->build( + Type => 'text/plain', + Subject => defined $args{Subject} ? Encode::encode_utf8( $args{'Subject'} ) : "", + (defined $args{'Cc'} ? + ( Cc => Encode::encode_utf8( $args{'Cc'} ) ) : ()), + Charset => 'UTF-8', + Data => $args{'Content'} || "", + ); + + my ( $Transaction, $Object, $Description ) = $self->Create( + Type => $args{'Type'} || 'ticket', + Queue => $args{'Queue'}, + Owner => $args{'Owner'}, + Requestor => $args{'Requestors'}, + Cc => $args{'Cc'}, + AdminCc => $args{'AdminCc'}, + InitialPriority => $args{'InitialPriority'}, + FinalPriority => $args{'FinalPriority'}, + TimeLeft => $args{'TimeLeft'}, + TimeEstimated => $args{'TimeEstimated'}, + TimeWorked => $args{'TimeWorked'}, + Subject => $args{'Subject'}, + Status => $args{'Status'}, + MIMEObj => $Message, + DryRun => 1, + ); + unless ( $Transaction ) { + $RT::Logger->error("Couldn't fire Create action: $Description"); + } + + return $Object; +} + + + +sub _Links { + my $self = shift; + + #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic --- + #tobias meant by $f + my $field = shift; + my $type = shift || ""; + + my $cache_key = "$field$type"; + return $self->{ $cache_key } if $self->{ $cache_key }; + + my $links = $self->{ $cache_key } + = RT::Links->new( $self->CurrentUser ); + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + $links->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' ); + return $links; + } + + # Maybe this ticket is a merge ticket + #my $limit_on = 'Local'. $field; + # at least to myself + $links->Limit( + FIELD => $field, #$limit_on, + OPERATOR => 'MATCHES', + VALUE => 'fsck.com-rt://%/ticket/'. $self->id, + ENTRYAGGREGATOR => 'OR', + ); + $links->Limit( + FIELD => $field, #$limit_on, + OPERATOR => 'MATCHES', + VALUE => 'fsck.com-rt://%/ticket/'. $_, + ENTRYAGGREGATOR => 'OR', + ) foreach $self->Merged; + $links->Limit( + FIELD => 'Type', + VALUE => $type, + ) if $type; + + return $links; +} + + + +=head2 DeleteLink + +Delete a link. takes a paramhash of Base, Target, Type, Silent, +SilentBase and SilentTarget. Either Base or Target must be null. +The null value will be replaced with this ticket's id. + +If Silent is true then no transaction would be recorded, in other +case you can control creation of transactions on both base and +target with SilentBase and SilentTarget respectively. By default +both transactions are created. + +=cut + +sub DeleteLink { + my $self = shift; + my %args = ( + Base => undef, + Target => undef, + Type => undef, + Silent => undef, + SilentBase => undef, + SilentTarget => undef, + @_ + ); + + unless ( $args{'Target'} || $args{'Base'} ) { + $RT::Logger->error("Base or Target must be specified"); + return ( 0, $self->loc('Either base or target must be specified') ); + } + + #check acls + my $right = 0; + $right++ if $self->CurrentUserHasRight('ModifyTicket'); + if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) { + return ( 0, $self->loc("Permission Denied") ); + } + + # If the other URI is an RT::Ticket, we want to make sure the user + # can modify it too... + my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} ); + return (0, $msg) unless $status; + if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) { + $right++; + } + if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) || + ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) ) + { + return ( 0, $self->loc("Permission Denied") ); + } + + my ($val, $Msg) = $self->SUPER::_DeleteLink(%args); + return ( 0, $Msg ) unless $val; + + return ( $val, $Msg ) if $args{'Silent'}; + + my ($direction, $remote_link); + + if ( $args{'Base'} ) { + $remote_link = $args{'Base'}; + $direction = 'Target'; + } + elsif ( $args{'Target'} ) { + $remote_link = $args{'Target'}; + $direction = 'Base'; + } + + my $remote_uri = RT::URI->new( $self->CurrentUser ); + $remote_uri->FromURI( $remote_link ); + + unless ( $args{ 'Silent'. $direction } ) { + my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( + Type => 'DeleteLink', + Field => $LINKDIRMAP{$args{'Type'}}->{$direction}, + OldValue => $remote_uri->URI || $remote_link, + TimeTaken => 0 + ); + $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; + } + + if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) { + my $OtherObj = $remote_uri->Object; + my ( $val, $Msg ) = $OtherObj->_NewTransaction( + Type => 'DeleteLink', + Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} + : $LINKDIRMAP{$args{'Type'}}->{Target}, + OldValue => $self->URI, + ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'), + TimeTaken => 0, + ); + $RT::Logger->error("Couldn't create transaction: $Msg") unless $val; + } + + return ( $val, $Msg ); +} + + + +=head2 AddLink + +Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket. + +If Silent is true then no transaction would be recorded, in other +case you can control creation of transactions on both base and +target with SilentBase and SilentTarget respectively. By default +both transactions are created. + +=cut + +sub AddLink { + my $self = shift; + my %args = ( Target => '', + Base => '', + Type => '', + Silent => undef, + SilentBase => undef, + SilentTarget => undef, + @_ ); + + unless ( $args{'Target'} || $args{'Base'} ) { + $RT::Logger->error("Base or Target must be specified"); + return ( 0, $self->loc('Either base or target must be specified') ); + } + + my $right = 0; + $right++ if $self->CurrentUserHasRight('ModifyTicket'); + if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) { + return ( 0, $self->loc("Permission Denied") ); + } + + # If the other URI is an RT::Ticket, we want to make sure the user + # can modify it too... + my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} ); + return (0, $msg) unless $status; + if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) { + $right++; + } + if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) || + ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) ) + { + return ( 0, $self->loc("Permission Denied") ); + } + + return ( 0, "Can't link to a deleted ticket" ) + if $other_ticket && lc $other_ticket->Status eq 'deleted'; + + return $self->_AddLink(%args); +} + +sub __GetTicketFromURI { + my $self = shift; + my %args = ( URI => '', @_ ); + + # If the other URI is an RT::Ticket, we want to make sure the user + # can modify it too... + my $uri_obj = RT::URI->new( $self->CurrentUser ); + unless ($uri_obj->FromURI( $args{'URI'} )) { + my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} ); + $RT::Logger->warning( $msg ); + return( 0, $msg ); + } + my $obj = $uri_obj->Resolver->Object; + unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) { + return (1, 'Found not a ticket', undef); + } + return (1, 'Found ticket', $obj); +} + +=head2 _AddLink + +Private non-acled variant of AddLink so that links can be added during create. + +=cut + +sub _AddLink { + my $self = shift; + my %args = ( Target => '', + Base => '', + Type => '', + Silent => undef, + SilentBase => undef, + SilentTarget => undef, + @_ ); + + my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args); + return ($val, $msg) if !$val || $exist; + return ($val, $msg) if $args{'Silent'}; + + my ($direction, $remote_link); + if ( $args{'Target'} ) { + $remote_link = $args{'Target'}; + $direction = 'Base'; + } elsif ( $args{'Base'} ) { + $remote_link = $args{'Base'}; + $direction = 'Target'; + } + + my $remote_uri = RT::URI->new( $self->CurrentUser ); + $remote_uri->FromURI( $remote_link ); + + unless ( $args{ 'Silent'. $direction } ) { + my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( + Type => 'AddLink', + Field => $LINKDIRMAP{$args{'Type'}}->{$direction}, + NewValue => $remote_uri->URI || $remote_link, + TimeTaken => 0 + ); + $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; + } + + if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) { + my $OtherObj = $remote_uri->Object; + my ( $val, $msg ) = $OtherObj->_NewTransaction( + Type => 'AddLink', + Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} + : $LINKDIRMAP{$args{'Type'}}->{Target}, + NewValue => $self->URI, + ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'), + TimeTaken => 0, + ); + $RT::Logger->error("Couldn't create transaction: $msg") unless $val; + } + + return ( $val, $msg ); +} + + + + +=head2 MergeInto + +MergeInto take the id of the ticket to merge this ticket into. + +=cut + +sub MergeInto { + my $self = shift; + my $ticket_id = shift; + + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + # Load up the new ticket. + my $MergeInto = RT::Ticket->new($self->CurrentUser); + $MergeInto->Load($ticket_id); + + # make sure it exists. + unless ( $MergeInto->Id ) { + return ( 0, $self->loc("New ticket doesn't exist") ); + } + + # Make sure the current user can modify the new ticket. + unless ( $MergeInto->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + delete $MERGE_CACHE{'effective'}{ $self->id }; + delete @{ $MERGE_CACHE{'merged'} }{ + $ticket_id, $MergeInto->id, $self->id + }; + + $RT::Handle->BeginTransaction(); + + $self->_MergeInto( $MergeInto ); + + $RT::Handle->Commit(); + + return ( 1, $self->loc("Merge Successful") ); +} + +sub _MergeInto { + my $self = shift; + my $MergeInto = shift; + + + # We use EffectiveId here even though it duplicates information from + # the links table becasue of the massive performance hit we'd take + # by trying to do a separate database query for merge info everytime + # loaded a ticket. + + #update this ticket's effective id to the new ticket's id. + my ( $id_val, $id_msg ) = $self->__Set( + Field => 'EffectiveId', + Value => $MergeInto->Id() + ); + + unless ($id_val) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Merge failed. Couldn't set EffectiveId") ); + } + + + my $force_status = $self->QueueObj->Lifecycle->DefaultOnMerge; + if ( $force_status && $force_status ne $self->__Value('Status') ) { + my ( $status_val, $status_msg ) + = $self->__Set( Field => 'Status', Value => $force_status ); + + unless ($status_val) { + $RT::Handle->Rollback(); + $RT::Logger->error( + "Couldn't set status to $force_status. RT's Database may be inconsistent." + ); + return ( 0, $self->loc("Merge failed. Couldn't set Status") ); + } + } + + # update all the links that point to that old ticket + my $old_links_to = RT::Links->new($self->CurrentUser); + $old_links_to->Limit(FIELD => 'Target', VALUE => $self->URI); + + my %old_seen; + while (my $link = $old_links_to->Next) { + if (exists $old_seen{$link->Base."-".$link->Type}) { + $link->Delete; + } + elsif ($link->Base eq $MergeInto->URI) { + $link->Delete; + } else { + # First, make sure the link doesn't already exist. then move it over. + my $tmp = RT::Link->new(RT->SystemUser); + $tmp->LoadByCols(Base => $link->Base, Type => $link->Type, LocalTarget => $MergeInto->id); + if ($tmp->id) { + $link->Delete; + } else { + $link->SetTarget($MergeInto->URI); + $link->SetLocalTarget($MergeInto->id); + } + $old_seen{$link->Base."-".$link->Type} =1; + } + + } + + my $old_links_from = RT::Links->new($self->CurrentUser); + $old_links_from->Limit(FIELD => 'Base', VALUE => $self->URI); + + while (my $link = $old_links_from->Next) { + if (exists $old_seen{$link->Type."-".$link->Target}) { + $link->Delete; + } + if ($link->Target eq $MergeInto->URI) { + $link->Delete; + } else { + # First, make sure the link doesn't already exist. then move it over. + my $tmp = RT::Link->new(RT->SystemUser); + $tmp->LoadByCols(Target => $link->Target, Type => $link->Type, LocalBase => $MergeInto->id); + if ($tmp->id) { + $link->Delete; + } else { + $link->SetBase($MergeInto->URI); + $link->SetLocalBase($MergeInto->id); + $old_seen{$link->Type."-".$link->Target} =1; + } + } + + } + + # Update time fields + foreach my $type (qw(TimeEstimated TimeWorked TimeLeft)) { + + my $mutator = "Set$type"; + $MergeInto->$mutator( + ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ) ); + + } +#add all of this ticket's watchers to that ticket. + foreach my $watcher_type (qw(Requestors Cc AdminCc)) { + + my $people = $self->$watcher_type->MembersObj; + my $addwatcher_type = $watcher_type; + $addwatcher_type =~ s/s$//; + + while ( my $watcher = $people->Next ) { + + my ($val, $msg) = $MergeInto->_AddWatcher( + Type => $addwatcher_type, + Silent => 1, + PrincipalId => $watcher->MemberId + ); + unless ($val) { + $RT::Logger->debug($msg); + } + } + + } + + #find all of the tickets that were merged into this ticket. + my $old_mergees = RT::Tickets->new( $self->CurrentUser ); + $old_mergees->Limit( + FIELD => 'EffectiveId', + OPERATOR => '=', + VALUE => $self->Id + ); + + # update their EffectiveId fields to the new ticket's id + while ( my $ticket = $old_mergees->Next() ) { + my ( $val, $msg ) = $ticket->__Set( + Field => 'EffectiveId', + Value => $MergeInto->Id() + ); + } + + #make a new link: this ticket is merged into that other ticket. + $self->AddLink( Type => 'MergedInto', Target => $MergeInto->Id()); + + $MergeInto->_SetLastUpdated; +} + +=head2 Merged + +Returns list of tickets' ids that's been merged into this ticket. + +=cut + +sub Merged { + my $self = shift; + + my $id = $self->id; + return @{ $MERGE_CACHE{'merged'}{ $id } } + if $MERGE_CACHE{'merged'}{ $id }; + + my $mergees = RT::Tickets->new( $self->CurrentUser ); + $mergees->Limit( + FIELD => 'EffectiveId', + VALUE => $id, + ); + $mergees->Limit( + FIELD => 'id', + OPERATOR => '!=', + VALUE => $id, + ); + return @{ $MERGE_CACHE{'merged'}{ $id } ||= [] } + = map $_->id, @{ $mergees->ItemsArrayRef || [] }; +} + + + + + +=head2 OwnerObj + +Takes nothing and returns an RT::User object of +this ticket's owner + +=cut + +sub OwnerObj { + my $self = shift; + + #If this gets ACLed, we lose on a rights check in User.pm and + #get deep recursion. if we need ACLs here, we need + #an equiv without ACLs + + my $owner = RT::User->new( $self->CurrentUser ); + $owner->Load( $self->__Value('Owner') ); + + #Return the owner object + return ($owner); +} + + + +=head2 OwnerAsString + +Returns the owner's email address + +=cut + +sub OwnerAsString { + my $self = shift; + return ( $self->OwnerObj->EmailAddress ); + +} + + + +=head2 SetOwner + +Takes two arguments: + the Id or Name of the owner +and (optionally) the type of the SetOwner Transaction. It defaults +to 'Set'. 'Steal' is also a valid option. + + +=cut + +sub SetOwner { + my $self = shift; + my $NewOwner = shift; + my $Type = shift || "Set"; + + $RT::Handle->BeginTransaction(); + + $self->_SetLastUpdated(); # lock the ticket + $self->Load( $self->id ); # in case $self changed while waiting for lock + + my $OldOwnerObj = $self->OwnerObj; + + my $NewOwnerObj = RT::User->new( $self->CurrentUser ); + $NewOwnerObj->Load( $NewOwner ); + unless ( $NewOwnerObj->Id ) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("That user does not exist") ); + } + + + # must have ModifyTicket rights + # or TakeTicket/StealTicket and $NewOwner is self + # see if it's a take + if ( $OldOwnerObj->Id == RT->Nobody->Id ) { + unless ( $self->CurrentUserHasRight('ModifyTicket') + || $self->CurrentUserHasRight('TakeTicket') ) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Permission Denied") ); + } + } + + # see if it's a steal + elsif ( $OldOwnerObj->Id != RT->Nobody->Id + && $OldOwnerObj->Id != $self->CurrentUser->id ) { + + unless ( $self->CurrentUserHasRight('ModifyTicket') + || $self->CurrentUserHasRight('StealTicket') ) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Permission Denied") ); + } + } + else { + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Permission Denied") ); + } + } + + # If we're not stealing and the ticket has an owner and it's not + # the current user + if ( $Type ne 'Steal' and $Type ne 'Force' + and $OldOwnerObj->Id != RT->Nobody->Id + and $OldOwnerObj->Id != $self->CurrentUser->Id ) + { + $RT::Handle->Rollback(); + return ( 0, $self->loc("You can only take tickets that are unowned") ) + if $NewOwnerObj->id == $self->CurrentUser->id; + return ( + 0, + $self->loc("You can only reassign tickets that you own or that are unowned" ) + ); + } + + #If we've specified a new owner and that user can't modify the ticket + elsif ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("That user may not own tickets in that queue") ); + } + + # If the ticket has an owner and it's the new owner, we don't need + # To do anything + elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("That user already owns that ticket") ); + } + + # Delete the owner in the owner group, then add a new one + # TODO: is this safe? it's not how we really want the API to work + # for most things, but it's fast. + my ( $del_id, $del_msg ); + for my $owner (@{$self->OwnerGroup->MembersObj->ItemsArrayRef}) { + ($del_id, $del_msg) = $owner->Delete(); + last unless ($del_id); + } + + unless ($del_id) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Could not change owner: [_1]", $del_msg) ); + } + + my ( $add_id, $add_msg ) = $self->OwnerGroup->_AddMember( + PrincipalId => $NewOwnerObj->PrincipalId, + InsideTransaction => 1 ); + unless ($add_id) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Could not change owner: [_1]", $add_msg ) ); + } + + # We call set twice with slightly different arguments, so + # as to not have an SQL transaction span two RT transactions + + my ( $val, $msg ) = $self->_Set( + Field => 'Owner', + RecordTransaction => 0, + Value => $NewOwnerObj->Id, + TimeTaken => 0, + TransactionType => 'Set', + CheckACL => 0, # don't check acl + ); + + unless ($val) { + $RT::Handle->Rollback; + return ( 0, $self->loc("Could not change owner: [_1]", $msg) ); + } + + ($val, $msg) = $self->_NewTransaction( + Type => 'Set', + Field => 'Owner', + NewValue => $NewOwnerObj->Id, + OldValue => $OldOwnerObj->Id, + TimeTaken => 0, + ); + + if ( $val ) { + $msg = $self->loc( "Owner changed from [_1] to [_2]", + $OldOwnerObj->Name, $NewOwnerObj->Name ); + } + else { + $RT::Handle->Rollback(); + return ( 0, $msg ); + } + + $RT::Handle->Commit(); + + return ( $val, $msg ); +} + + + +=head2 Take + +A convenince method to set the ticket's owner to the current user + +=cut + +sub Take { + my $self = shift; + return ( $self->SetOwner( $self->CurrentUser->Id, 'Take' ) ); +} + + + +=head2 Untake + +Convenience method to set the owner to 'nobody' if the current user is the owner. + +=cut + +sub Untake { + my $self = shift; + return ( $self->SetOwner( RT->Nobody->UserObj->Id, 'Untake' ) ); +} + + + +=head2 Steal + +A convenience method to change the owner of the current ticket to the +current user. Even if it's owned by another user. + +=cut + +sub Steal { + my $self = shift; + + if ( $self->IsOwner( $self->CurrentUser ) ) { + return ( 0, $self->loc("You already own this ticket") ); + } + else { + return ( $self->SetOwner( $self->CurrentUser->Id, 'Steal' ) ); + + } + +} + + + + + +=head2 ValidateStatus STATUS + +Takes a string. Returns true if that status is a valid status for this ticket. +Returns false otherwise. + +=cut + +sub ValidateStatus { + my $self = shift; + my $status = shift; + + #Make sure the status passed in is valid + return 1 if $self->QueueObj->IsValidStatus($status); + + my $i = 0; + while ( my $caller = (caller($i++))[3] ) { + return 1 if $caller eq 'RT::Ticket::SetQueue'; + } + + return 0; +} + +sub Status { + my $self = shift; + my $value = $self->_Value( 'Status' ); + return $value unless $self->QueueObj; + return $self->QueueObj->Lifecycle->CanonicalCase( $value ); +} + +=head2 SetStatus STATUS + +Set this ticket's status. STATUS can be one of: new, open, stalled, resolved, rejected or deleted. + +Alternatively, you can pass in a list of named parameters (Status => STATUS, Force => FORCE, SetStarted => SETSTARTED ). +If FORCE is true, ignore unresolved dependencies and force a status change. +if SETSTARTED is true( it's the default value), set Started to current datetime if Started +is not set and the status is changed from initial to not initial. + +=cut + +sub SetStatus { + my $self = shift; + my %args; + if (@_ == 1) { + $args{Status} = shift; + } + else { + %args = (@_); + } + + # this only allows us to SetStarted, not we must SetStarted. + # this option was added for rtir initially + $args{SetStarted} = 1 unless exists $args{SetStarted}; + + + my $lifecycle = $self->QueueObj->Lifecycle; + + my $new = lc $args{'Status'}; + unless ( $lifecycle->IsValid( $new ) ) { + return (0, $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.", $self->loc($new))); + } + + my $old = $self->__Value('Status'); + unless ( $lifecycle->IsTransition( $old => $new ) ) { + return (0, $self->loc("You can't change status from '[_1]' to '[_2]'.", $self->loc($old), $self->loc($new))); + } + + my $check_right = $lifecycle->CheckRight( $old => $new ); + unless ( $self->CurrentUserHasRight( $check_right ) ) { + return ( 0, $self->loc('Permission Denied') ); + } + + if ( !$args{Force} && $lifecycle->IsInactive( $new ) && $self->HasUnresolvedDependencies) { + return (0, $self->loc('That ticket has unresolved dependencies')); + } + + my $now = RT::Date->new( $self->CurrentUser ); + $now->SetToNow(); + + my $raw_started = RT::Date->new(RT->SystemUser); + $raw_started->Set(Format => 'ISO', Value => $self->__Value('Started')); + + #If we're changing the status from new, record that we've started + if ( $args{SetStarted} && $lifecycle->IsInitial($old) && !$lifecycle->IsInitial($new) && !$raw_started->Unix) { + #Set the Started time to "now" + $self->_Set( + Field => 'Started', + Value => $now->ISO, + RecordTransaction => 0 + ); + } + + #When we close a ticket, set the 'Resolved' attribute to now. + # It's misnamed, but that's just historical. + if ( $lifecycle->IsInactive($new) ) { + $self->_Set( + Field => 'Resolved', + Value => $now->ISO, + RecordTransaction => 0, + ); + } + + #Actually update the status + my ($val, $msg)= $self->_Set( + Field => 'Status', + Value => $new, + TimeTaken => 0, + CheckACL => 0, + TransactionType => 'Status', + ); + return ($val, $msg); +} + + + +=head2 Delete + +Takes no arguments. Marks this ticket for garbage collection + +=cut + +sub Delete { + my $self = shift; + unless ( $self->QueueObj->Lifecycle->IsValid('deleted') ) { + return (0, $self->loc('Delete operation is disabled by lifecycle configuration') ); #loc + } + return ( $self->SetStatus('deleted') ); +} + + +=head2 SetTold ISO [TIMETAKEN] + +Updates the told and records a transaction + +=cut + +sub SetTold { + my $self = shift; + my $told; + $told = shift if (@_); + my $timetaken = shift || 0; + + unless ( $self->CurrentUserHasRight('ModifyTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + my $datetold = RT::Date->new( $self->CurrentUser ); + if ($told) { + $datetold->Set( Format => 'iso', + Value => $told ); + } + else { + $datetold->SetToNow(); + } + + return ( $self->_Set( Field => 'Told', + Value => $datetold->ISO, + TimeTaken => $timetaken, + TransactionType => 'Told' ) ); +} + +=head2 _SetTold + +Updates the told without a transaction or acl check. Useful when we're sending replies. + +=cut + +sub _SetTold { + my $self = shift; + + my $now = RT::Date->new( $self->CurrentUser ); + $now->SetToNow(); + + #use __Set to get no ACLs ;) + return ( $self->__Set( Field => 'Told', + Value => $now->ISO ) ); +} + +=head2 SeenUpTo + + +=cut + +sub SeenUpTo { + my $self = shift; + my $uid = $self->CurrentUser->id; + my $attr = $self->FirstAttribute( "User-". $uid ."-SeenUpTo" ); + return if $attr && $attr->Content gt $self->LastUpdated; + + my $txns = $self->Transactions; + $txns->Limit( FIELD => 'Type', VALUE => 'Comment' ); + $txns->Limit( FIELD => 'Type', VALUE => 'Correspond' ); + $txns->Limit( FIELD => 'Creator', OPERATOR => '!=', VALUE => $uid ); + $txns->Limit( + FIELD => 'Created', + OPERATOR => '>', + VALUE => $attr->Content + ) if $attr; + $txns->RowsPerPage(1); + return $txns->First; +} + +=head2 RanTransactionBatch + +Acts as a guard around running TransactionBatch scrips. + +Should be false until you enter the code that runs TransactionBatch scrips + +Accepts an optional argument to indicate that TransactionBatch Scrips should no longer be run on this object. + +=cut + +sub RanTransactionBatch { + my $self = shift; + my $val = shift; + + if ( defined $val ) { + return $self->{_RanTransactionBatch} = $val; + } else { + return $self->{_RanTransactionBatch}; + } + +} + + +=head2 TransactionBatch + +Returns an array reference of all transactions created on this ticket during +this ticket object's lifetime or since last application of a batch, or undef +if there were none. + +Only works when the C<UseTransactionBatch> config option is set to true. + +=cut + +sub TransactionBatch { + my $self = shift; + return $self->{_TransactionBatch}; +} + +=head2 ApplyTransactionBatch + +Applies scrips on the current batch of transactions and shinks it. Usually +batch is applied when object is destroyed, but in some cases it's too late. + +=cut + +sub ApplyTransactionBatch { + my $self = shift; + + my $batch = $self->TransactionBatch; + return unless $batch && @$batch; + + $self->_ApplyTransactionBatch; + + $self->{_TransactionBatch} = []; +} + +sub _ApplyTransactionBatch { + my $self = shift; + + return if $self->RanTransactionBatch; + $self->RanTransactionBatch(1); + + my $still_exists = RT::Ticket->new( RT->SystemUser ); + $still_exists->Load( $self->Id ); + if (not $still_exists->Id) { + # The ticket has been removed from the database, but we still + # have pending TransactionBatch txns for it. Unfortunately, + # because it isn't in the DB anymore, attempting to run scrips + # on it may produce unpredictable results; simply drop the + # batched transactions. + $RT::Logger->warning("TransactionBatch was fired on a ticket that no longer exists; unable to run scrips! Call ->ApplyTransactionBatch before shredding the ticket, for consistent results."); + return; + } + + my $batch = $self->TransactionBatch; + + my %seen; + my $types = join ',', grep !$seen{$_}++, grep defined, map $_->__Value('Type'), grep defined, @{$batch}; + + require RT::Scrips; + RT::Scrips->new(RT->SystemUser)->Apply( + Stage => 'TransactionBatch', + TicketObj => $self, + TransactionObj => $batch->[0], + Type => $types, + ); + + # Entry point of the rule system + my $rules = RT::Ruleset->FindAllRules( + Stage => 'TransactionBatch', + TicketObj => $self, + TransactionObj => $batch->[0], + Type => $types, + ); + RT::Ruleset->CommitRules($rules); +} + +sub DESTROY { + my $self = shift; + + # DESTROY methods need to localize $@, or it may unset it. This + # causes $m->abort to not bubble all of the way up. See perlbug + # http://rt.perl.org/rt3/Ticket/Display.html?id=17650 + local $@; + + # The following line eliminates reentrancy. + # It protects against the fact that perl doesn't deal gracefully + # when an object's refcount is changed in its destructor. + return if $self->{_Destroyed}++; + + if (in_global_destruction()) { + unless ($ENV{'HARNESS_ACTIVE'}) { + warn "Too late to safely run transaction-batch scrips!" + ." This is typically caused by using ticket objects" + ." at the top-level of a script which uses the RT API." + ." Be sure to explicitly undef such ticket objects," + ." or put them inside of a lexical scope."; + } + return; + } + + return $self->ApplyTransactionBatch; +} + + + + +sub _OverlayAccessible { + { + EffectiveId => { 'read' => 1, 'write' => 1, 'public' => 1 }, + Queue => { 'read' => 1, 'write' => 1 }, + Requestors => { 'read' => 1, 'write' => 1 }, + Owner => { 'read' => 1, 'write' => 1 }, + Subject => { 'read' => 1, 'write' => 1 }, + InitialPriority => { 'read' => 1, 'write' => 1 }, + FinalPriority => { 'read' => 1, 'write' => 1 }, + Priority => { 'read' => 1, 'write' => 1 }, + Status => { 'read' => 1, 'write' => 1 }, + TimeEstimated => { 'read' => 1, 'write' => 1 }, + TimeWorked => { 'read' => 1, 'write' => 1 }, + TimeLeft => { 'read' => 1, 'write' => 1 }, + Told => { 'read' => 1, 'write' => 1 }, + Resolved => { 'read' => 1 }, + Type => { 'read' => 1 }, + Starts => { 'read' => 1, 'write' => 1 }, + Started => { 'read' => 1, 'write' => 1 }, + Due => { 'read' => 1, 'write' => 1 }, + Creator => { 'read' => 1, 'auto' => 1 }, + Created => { 'read' => 1, 'auto' => 1 }, + LastUpdatedBy => { 'read' => 1, 'auto' => 1 }, + LastUpdated => { 'read' => 1, 'auto' => 1 } + }; + +} + + + +sub _Set { + my $self = shift; + + my %args = ( Field => undef, + Value => undef, + TimeTaken => 0, + RecordTransaction => 1, + UpdateTicket => 1, + CheckACL => 1, + TransactionType => 'Set', + @_ ); + + if ($args{'CheckACL'}) { + unless ( $self->CurrentUserHasRight('ModifyTicket')) { + return ( 0, $self->loc("Permission Denied")); + } + } + + unless ($args{'UpdateTicket'} || $args{'RecordTransaction'}) { + $RT::Logger->error("Ticket->_Set called without a mandate to record an update or update the ticket"); + return(0, $self->loc("Internal Error")); + } + + #if the user is trying to modify the record + + #Take care of the old value we really don't want to get in an ACL loop. + # so ask the super::_Value + my $Old = $self->SUPER::_Value("$args{'Field'}"); + + my ($ret, $msg); + if ( $args{'UpdateTicket'} ) { + + #Set the new value + ( $ret, $msg ) = $self->SUPER::_Set( Field => $args{'Field'}, + Value => $args{'Value'} ); + + #If we can't actually set the field to the value, don't record + # a transaction. instead, get out of here. + return ( 0, $msg ) unless $ret; + } + + if ( $args{'RecordTransaction'} == 1 ) { + + my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( + Type => $args{'TransactionType'}, + Field => $args{'Field'}, + NewValue => $args{'Value'}, + OldValue => $Old, + TimeTaken => $args{'TimeTaken'}, + ); + # Ensure that we can read the transaction, even if the change + # just made the ticket unreadable to us + $TransObj->{ _object_is_readable } = 1; + return ( $Trans, scalar $TransObj->BriefDescription ); + } + else { + return ( $ret, $msg ); + } +} + + + +=head2 _Value + +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check + +=cut + +sub _Value { + + my $self = shift; + my $field = shift; + + #if the field is public, return it. + if ( $self->_Accessible( $field, 'public' ) ) { + + #$RT::Logger->debug("Skipping ACL check for $field"); + return ( $self->SUPER::_Value($field) ); + + } + + #If the current user doesn't have ACLs, don't let em at it. + + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + return (undef); + } + return ( $self->SUPER::_Value($field) ); + +} + + + +=head2 _UpdateTimeTaken + +This routine will increment the timeworked counter. it should +only be called from _NewTransaction + +=cut + +sub _UpdateTimeTaken { + my $self = shift; + my $Minutes = shift; + my ($Total); + + $Total = $self->SUPER::_Value("TimeWorked"); + $Total = ( $Total || 0 ) + ( $Minutes || 0 ); + $self->SUPER::_Set( + Field => "TimeWorked", + Value => $Total + ); + + return ($Total); +} + + + + + +=head2 CurrentUserHasRight + + Takes the textual name of a Ticket scoped right (from RT::ACE) and returns +1 if the user has that right. It returns 0 if the user doesn't have that right. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return $self->CurrentUser->PrincipalObj->HasRight( + Object => $self, + Right => $right, + ) +} + + +=head2 CurrentUserCanSee + +Returns true if the current user can see the ticket, using ShowTicket + +=cut + +sub CurrentUserCanSee { + my $self = shift; + return $self->CurrentUserHasRight('ShowTicket'); +} + +=head2 HasRight + + Takes a paramhash with the attributes 'Right' and 'Principal' + 'Right' is a ticket-scoped textual right from RT::ACE + 'Principal' is an RT::User object + + Returns 1 if the principal has the right. Returns undef if not. + +=cut + +sub HasRight { + my $self = shift; + my %args = ( + Right => undef, + Principal => undef, + @_ + ); + + unless ( ( defined $args{'Principal'} ) and ( ref( $args{'Principal'} ) ) ) + { + Carp::cluck("Principal attrib undefined for Ticket::HasRight"); + $RT::Logger->crit("Principal attrib undefined for Ticket::HasRight"); + return(undef); + } + + return ( + $args{'Principal'}->HasRight( + Object => $self, + Right => $args{'Right'} + ) + ); +} + + + +=head2 Reminders + +Return the Reminders object for this ticket. (It's an RT::Reminders object.) +It isn't acutally a searchbuilder collection itself. + +=cut + +sub Reminders { + my $self = shift; + + unless ($self->{'__reminders'}) { + $self->{'__reminders'} = RT::Reminders->new($self->CurrentUser); + $self->{'__reminders'}->Ticket($self->id); + } + return $self->{'__reminders'}; + +} + + + + +=head2 Transactions + + Returns an RT::Transactions object of all transactions on this ticket + +=cut + +sub Transactions { + my $self = shift; + + my $transactions = RT::Transactions->new( $self->CurrentUser ); + + #If the user has no rights, return an empty object + if ( $self->CurrentUserHasRight('ShowTicket') ) { + $transactions->LimitToTicket($self->id); + + # if the user may not see comments do not return them + unless ( $self->CurrentUserHasRight('ShowTicketComments') ) { + $transactions->Limit( + SUBCLAUSE => 'acl', + FIELD => 'Type', + OPERATOR => '!=', + VALUE => "Comment" + ); + $transactions->Limit( + SUBCLAUSE => 'acl', + FIELD => 'Type', + OPERATOR => '!=', + VALUE => "CommentEmailRecord", + ENTRYAGGREGATOR => 'AND' + ); + + } + } else { + $transactions->Limit( + SUBCLAUSE => 'acl', + FIELD => 'id', + VALUE => 0, + ENTRYAGGREGATOR => 'AND' + ); + } + + return ($transactions); +} + + + + +=head2 TransactionCustomFields + + Returns the custom fields that transactions on tickets will have. + +=cut + +sub TransactionCustomFields { + my $self = shift; + my $cfs = $self->QueueObj->TicketTransactionCustomFields; + $cfs->SetContextObject( $self ); + return $cfs; +} + + +=head2 LoadCustomFieldByIdentifier + +Finds and returns the custom field of the given name for the ticket, +overriding L<RT::Record/LoadCustomFieldByIdentifier> to look for +queue-specific CFs before global ones. + +=cut + +sub LoadCustomFieldByIdentifier { + my $self = shift; + my $field = shift; + + return $self->SUPER::LoadCustomFieldByIdentifier($field) + if ref $field or $field =~ /^\d+$/; + + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->SetContextObject( $self ); + $cf->LoadByNameAndQueue( Name => $field, Queue => $self->Queue ); + $cf->LoadByNameAndQueue( Name => $field, Queue => 0 ) unless $cf->id; + return $cf; +} + + +=head2 CustomFieldLookupType + +Returns the RT::Ticket lookup type, which can be passed to +RT::CustomField->Create() via the 'LookupType' hash key. + +=cut + + +sub CustomFieldLookupType { + "RT::Queue-RT::Ticket"; +} + +=head2 ACLEquivalenceObjects + +This method returns a list of objects for which a user's rights also apply +to this ticket. Generally, this is only the ticket's queue, but some RT +extensions may make other objects available too. + +This method is called from L<RT::Principal/HasRight>. + +=cut + +sub ACLEquivalenceObjects { + my $self = shift; + return $self->QueueObj; + +} + + +1; + +=head1 AUTHOR + +Jesse Vincent, jesse@bestpractical.com + +=head1 SEE ALSO + +RT + +=cut + + +use RT::Queue; +use base 'RT::Record'; + +sub Table {'Tickets'} + + + + + + +=head2 id + +Returns the current value of id. +(In the database, id is stored as int(11).) + + +=cut + + +=head2 EffectiveId + +Returns the current value of EffectiveId. +(In the database, EffectiveId is stored as int(11).) + + + +=head2 SetEffectiveId VALUE + + +Set EffectiveId to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, EffectiveId will be stored as a int(11).) + + +=cut + + +=head2 Queue + +Returns the current value of Queue. +(In the database, Queue is stored as int(11).) + + + +=head2 SetQueue VALUE + + +Set Queue to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Queue will be stored as a int(11).) + + +=cut + + +=head2 Type + +Returns the current value of Type. +(In the database, Type is stored as varchar(16).) + + + +=head2 SetType VALUE + + +Set Type to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Type will be stored as a varchar(16).) + + +=cut + + +=head2 IssueStatement + +Returns the current value of IssueStatement. +(In the database, IssueStatement is stored as int(11).) + + + +=head2 SetIssueStatement VALUE + + +Set IssueStatement to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, IssueStatement will be stored as a int(11).) + + +=cut + + +=head2 Resolution + +Returns the current value of Resolution. +(In the database, Resolution is stored as int(11).) + + + +=head2 SetResolution VALUE + + +Set Resolution to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Resolution will be stored as a int(11).) + + +=cut + + +=head2 Owner + +Returns the current value of Owner. +(In the database, Owner is stored as int(11).) + + + +=head2 SetOwner VALUE + + +Set Owner to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Owner will be stored as a int(11).) + + +=cut + + +=head2 Subject + +Returns the current value of Subject. +(In the database, Subject is stored as varchar(200).) + + + +=head2 SetSubject VALUE + + +Set Subject to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Subject will be stored as a varchar(200).) + + +=cut + + +=head2 InitialPriority + +Returns the current value of InitialPriority. +(In the database, InitialPriority is stored as int(11).) + + + +=head2 SetInitialPriority VALUE + + +Set InitialPriority to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, InitialPriority will be stored as a int(11).) + + +=cut + + +=head2 FinalPriority + +Returns the current value of FinalPriority. +(In the database, FinalPriority is stored as int(11).) + + + +=head2 SetFinalPriority VALUE + + +Set FinalPriority to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, FinalPriority will be stored as a int(11).) + + +=cut + + +=head2 Priority + +Returns the current value of Priority. +(In the database, Priority is stored as int(11).) + + + +=head2 SetPriority VALUE + + +Set Priority to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Priority will be stored as a int(11).) + + +=cut + + +=head2 TimeEstimated + +Returns the current value of TimeEstimated. +(In the database, TimeEstimated is stored as int(11).) + + + +=head2 SetTimeEstimated VALUE + + +Set TimeEstimated to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, TimeEstimated will be stored as a int(11).) + + +=cut + + +=head2 TimeWorked + +Returns the current value of TimeWorked. +(In the database, TimeWorked is stored as int(11).) + + + +=head2 SetTimeWorked VALUE + + +Set TimeWorked to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, TimeWorked will be stored as a int(11).) + + +=cut + + +=head2 Status + +Returns the current value of Status. +(In the database, Status is stored as varchar(64).) + + + +=head2 SetStatus VALUE + + +Set Status to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Status will be stored as a varchar(64).) + + +=cut + + +=head2 TimeLeft + +Returns the current value of TimeLeft. +(In the database, TimeLeft is stored as int(11).) + + + +=head2 SetTimeLeft VALUE + + +Set TimeLeft to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, TimeLeft will be stored as a int(11).) + + +=cut + + +=head2 Told + +Returns the current value of Told. +(In the database, Told is stored as datetime.) + + + +=head2 SetTold VALUE + + +Set Told to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Told will be stored as a datetime.) + + +=cut + + +=head2 Starts + +Returns the current value of Starts. +(In the database, Starts is stored as datetime.) + + + +=head2 SetStarts VALUE + + +Set Starts to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Starts will be stored as a datetime.) + + +=cut + + +=head2 Started + +Returns the current value of Started. +(In the database, Started is stored as datetime.) + + + +=head2 SetStarted VALUE + + +Set Started to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Started will be stored as a datetime.) + + +=cut + + +=head2 Due + +Returns the current value of Due. +(In the database, Due is stored as datetime.) + + + +=head2 SetDue VALUE + + +Set Due to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Due will be stored as a datetime.) + + +=cut + + +=head2 Resolved + +Returns the current value of Resolved. +(In the database, Resolved is stored as datetime.) + + + +=head2 SetResolved VALUE + + +Set Resolved to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Resolved will be stored as a datetime.) + + +=cut + + +=head2 LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=head2 LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) + + +=cut + + +=head2 Creator + +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) + + +=cut + + +=head2 Created + +Returns the current value of Created. +(In the database, Created is stored as datetime.) + + +=cut + + +=head2 Disabled + +Returns the current value of Disabled. +(In the database, Disabled is stored as smallint(6).) + + + +=head2 SetDisabled VALUE + + +Set Disabled to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Disabled will be stored as a smallint(6).) + + +=cut + + + +sub _CoreAccessible { + { + + id => + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + EffectiveId => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Queue => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Type => + {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, + IssueStatement => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Resolution => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Owner => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Subject => + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => '[no subject]'}, + InitialPriority => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + FinalPriority => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Priority => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + TimeEstimated => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + TimeWorked => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Status => + {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, + TimeLeft => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Told => + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Starts => + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Started => + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Due => + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Resolved => + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + LastUpdatedBy => + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + LastUpdated => + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Creator => + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + Created => + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + Disabled => + {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, + + } +}; + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Tickets.pm b/rt/lib/RT/Tickets.pm index cd5649dd9..4d091ce7a 100755 --- a/rt/lib/RT/Tickets.pm +++ b/rt/lib/RT/Tickets.pm @@ -1749,7 +1749,7 @@ sub _CustomFieldLimit { $self->_CloseParen; } elsif ( $op eq '=' || $op eq '!=' || $op eq '<>' ) { - if ( length( Encode::encode_utf8($value) ) < 256 ) { + if ( length( Encode::encode( "UTF-8", $value) ) < 256 ) { $self->_SQLLimit( ALIAS => $ObjectCFs, FIELD => 'Content', diff --git a/rt/lib/RT/Tickets.pm.orig b/rt/lib/RT/Tickets.pm.orig new file mode 100755 index 000000000..cd5649dd9 --- /dev/null +++ b/rt/lib/RT/Tickets.pm.orig @@ -0,0 +1,3892 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} + +# Major Changes: + +# - Decimated ProcessRestrictions and broke it into multiple +# functions joined by a LUT +# - Semi-Generic SQL stuff moved to another file + +# Known Issues: FIXME! + +# - ClearRestrictions and Reinitialization is messy and unclear. The +# only good way to do it is to create a new RT::Tickets object. + +=head1 NAME + + RT::Tickets - A collection of Ticket objects + + +=head1 SYNOPSIS + + use RT::Tickets; + my $tickets = RT::Tickets->new($CurrentUser); + +=head1 DESCRIPTION + + A collection of RT::Tickets. + +=head1 METHODS + + +=cut + +package RT::Tickets; + +use strict; +use warnings; + + +use RT::Ticket; + +use base 'RT::SearchBuilder'; + +sub Table { 'Tickets'} + +use RT::CustomFields; +use DBIx::SearchBuilder::Unique; + +# Configuration Tables: + +# FIELD_METADATA is a mapping of searchable Field name, to Type, and other +# metadata. + +our %FIELD_METADATA = ( + Status => [ 'ENUM', ], #loc_left_pair + Queue => [ 'ENUM' => 'Queue', ], #loc_left_pair + Type => [ 'ENUM', ], #loc_left_pair + Creator => [ 'ENUM' => 'User', ], #loc_left_pair + LastUpdatedBy => [ 'ENUM' => 'User', ], #loc_left_pair + Owner => [ 'WATCHERFIELD' => 'Owner', ], #loc_left_pair + EffectiveId => [ 'INT', ], #loc_left_pair + id => [ 'ID', ], #loc_left_pair + InitialPriority => [ 'INT', ], #loc_left_pair + FinalPriority => [ 'INT', ], #loc_left_pair + Priority => [ 'INT', ], #loc_left_pair + TimeLeft => [ 'INT', ], #loc_left_pair + TimeWorked => [ 'INT', ], #loc_left_pair + TimeEstimated => [ 'INT', ], #loc_left_pair + + Linked => [ 'LINK' ], #loc_left_pair + LinkedTo => [ 'LINK' => 'To' ], #loc_left_pair + LinkedFrom => [ 'LINK' => 'From' ], #loc_left_pair + MemberOf => [ 'LINK' => To => 'MemberOf', ], #loc_left_pair + DependsOn => [ 'LINK' => To => 'DependsOn', ], #loc_left_pair + RefersTo => [ 'LINK' => To => 'RefersTo', ], #loc_left_pair + HasMember => [ 'LINK' => From => 'MemberOf', ], #loc_left_pair + DependentOn => [ 'LINK' => From => 'DependsOn', ], #loc_left_pair + DependedOnBy => [ 'LINK' => From => 'DependsOn', ], #loc_left_pair + ReferredToBy => [ 'LINK' => From => 'RefersTo', ], #loc_left_pair + Told => [ 'DATE' => 'Told', ], #loc_left_pair + Starts => [ 'DATE' => 'Starts', ], #loc_left_pair + Started => [ 'DATE' => 'Started', ], #loc_left_pair + Due => [ 'DATE' => 'Due', ], #loc_left_pair + Resolved => [ 'DATE' => 'Resolved', ], #loc_left_pair + LastUpdated => [ 'DATE' => 'LastUpdated', ], #loc_left_pair + Created => [ 'DATE' => 'Created', ], #loc_left_pair + Subject => [ 'STRING', ], #loc_left_pair + Content => [ 'TRANSCONTENT', ], #loc_left_pair + ContentType => [ 'TRANSFIELD', ], #loc_left_pair + Filename => [ 'TRANSFIELD', ], #loc_left_pair + TransactionDate => [ 'TRANSDATE', ], #loc_left_pair + Requestor => [ 'WATCHERFIELD' => 'Requestor', ], #loc_left_pair + Requestors => [ 'WATCHERFIELD' => 'Requestor', ], #loc_left_pair + Cc => [ 'WATCHERFIELD' => 'Cc', ], #loc_left_pair + AdminCc => [ 'WATCHERFIELD' => 'AdminCc', ], #loc_left_pair + Watcher => [ 'WATCHERFIELD', ], #loc_left_pair + QueueCc => [ 'WATCHERFIELD' => 'Cc' => 'Queue', ], #loc_left_pair + QueueAdminCc => [ 'WATCHERFIELD' => 'AdminCc' => 'Queue', ], #loc_left_pair + QueueWatcher => [ 'WATCHERFIELD' => undef => 'Queue', ], #loc_left_pair + CustomFieldValue => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair + CustomField => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair + CF => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair + Updated => [ 'TRANSDATE', ], #loc_left_pair + RequestorGroup => [ 'MEMBERSHIPFIELD' => 'Requestor', ], #loc_left_pair + CCGroup => [ 'MEMBERSHIPFIELD' => 'Cc', ], #loc_left_pair + AdminCCGroup => [ 'MEMBERSHIPFIELD' => 'AdminCc', ], #loc_left_pair + WatcherGroup => [ 'MEMBERSHIPFIELD', ], #loc_left_pair + HasAttribute => [ 'HASATTRIBUTE', 1 ], + HasNoAttribute => [ 'HASATTRIBUTE', 0 ], + #freeside + Customer => [ 'FREESIDEFIELD' => 'Customer' ], + Service => [ 'FREESIDEFIELD' => 'Service' ], + WillResolve => [ 'DATE' => 'WillResolve', ], #loc_left_pair +); + +# Lower Case version of FIELDS, for case insensitivity +our %LOWER_CASE_FIELDS = map { ( lc($_) => $_ ) } (keys %FIELD_METADATA); + +our %SEARCHABLE_SUBFIELDS = ( + User => [qw( + EmailAddress Name RealName Nickname Organization Address1 Address2 + WorkPhone HomePhone MobilePhone PagerPhone id + )], +); + +# Mapping of Field Type to Function +our %dispatch = ( + ENUM => \&_EnumLimit, + INT => \&_IntLimit, + ID => \&_IdLimit, + LINK => \&_LinkLimit, + DATE => \&_DateLimit, + STRING => \&_StringLimit, + TRANSFIELD => \&_TransLimit, + TRANSCONTENT => \&_TransContentLimit, + TRANSDATE => \&_TransDateLimit, + WATCHERFIELD => \&_WatcherLimit, + MEMBERSHIPFIELD => \&_WatcherMembershipLimit, + CUSTOMFIELD => \&_CustomFieldLimit, + HASATTRIBUTE => \&_HasAttributeLimit, + FREESIDEFIELD => \&_FreesideFieldLimit, +); +our %can_bundle = ();# WATCHERFIELD => "yes", ); + +# Default EntryAggregator per type +# if you specify OP, you must specify all valid OPs +my %DefaultEA = ( + INT => 'AND', + ENUM => { + '=' => 'OR', + '!=' => 'AND' + }, + DATE => { + '=' => 'OR', + '>=' => 'AND', + '<=' => 'AND', + '>' => 'AND', + '<' => 'AND' + }, + STRING => { + '=' => 'OR', + '!=' => 'AND', + 'LIKE' => 'AND', + 'NOT LIKE' => 'AND' + }, + TRANSFIELD => 'AND', + TRANSDATE => 'AND', + LINK => 'OR', + LINKFIELD => 'AND', + TARGET => 'AND', + BASE => 'AND', + WATCHERFIELD => { + '=' => 'OR', + '!=' => 'AND', + 'LIKE' => 'OR', + 'NOT LIKE' => 'AND' + }, + + HASATTRIBUTE => { + '=' => 'AND', + '!=' => 'AND', + }, + + CUSTOMFIELD => 'OR', +); + +# Helper functions for passing the above lexically scoped tables above +# into Tickets_SQL. +sub FIELDS { return \%FIELD_METADATA } +sub dispatch { return \%dispatch } +sub can_bundle { return \%can_bundle } + +# Bring in the clowns. +require RT::Tickets_SQL; + + +our @SORTFIELDS = qw(id Status + Queue Subject + Owner Created Due Starts Started + Told + Resolved LastUpdated Priority TimeWorked TimeLeft); + +=head2 SortFields + +Returns the list of fields that lists of tickets can easily be sorted by + +=cut + +sub SortFields { + my $self = shift; + return (@SORTFIELDS); +} + + +# BEGIN SQL STUFF ********************************* + + +sub CleanSlate { + my $self = shift; + $self->SUPER::CleanSlate( @_ ); + delete $self->{$_} foreach qw( + _sql_cf_alias + _sql_group_members_aliases + _sql_object_cfv_alias + _sql_role_group_aliases + _sql_trattachalias + _sql_u_watchers_alias_for_sort + _sql_u_watchers_aliases + _sql_current_user_can_see_applied + ); +} + +=head1 Limit Helper Routines + +These routines are the targets of a dispatch table depending on the +type of field. They all share the same signature: + + my ($self,$field,$op,$value,@rest) = @_; + +The values in @rest should be suitable for passing directly to +DBIx::SearchBuilder::Limit. + +Essentially they are an expanded/broken out (and much simplified) +version of what ProcessRestrictions used to do. They're also much +more clearly delineated by the TYPE of field being processed. + +=head2 _IdLimit + +Handle ID field. + +=cut + +sub _IdLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + if ( $value eq '__Bookmarked__' ) { + return $sb->_BookmarkLimit( $field, $op, $value, @rest ); + } else { + return $sb->_IntLimit( $field, $op, $value, @rest ); + } +} + +sub _BookmarkLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + die "Invalid operator $op for __Bookmarked__ search on $field" + unless $op =~ /^(=|!=)$/; + + my @bookmarks = do { + my $tmp = $sb->CurrentUser->UserObj->FirstAttribute('Bookmarks'); + $tmp = $tmp->Content if $tmp; + $tmp ||= {}; + grep $_, keys %$tmp; + }; + + return $sb->_SQLLimit( + FIELD => $field, + OPERATOR => $op, + VALUE => 0, + @rest, + ) unless @bookmarks; + + # as bookmarked tickets can be merged we have to use a join + # but it should be pretty lightweight + my $tickets_alias = $sb->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Tickets', + FIELD2 => 'EffectiveId', + ); + $sb->_OpenParen; + my $first = 1; + my $ea = $op eq '='? 'OR': 'AND'; + foreach my $id ( sort @bookmarks ) { + $sb->_SQLLimit( + ALIAS => $tickets_alias, + FIELD => 'id', + OPERATOR => $op, + VALUE => $id, + $first? (@rest): ( ENTRYAGGREGATOR => $ea ) + ); + $first = 0 if $first; + } + $sb->_CloseParen; +} + +=head2 _EnumLimit + +Handle Fields which are limited to certain values, and potentially +need to be looked up from another class. + +This subroutine actually handles two different kinds of fields. For +some the user is responsible for limiting the values. (i.e. Status, +Type). + +For others, the value specified by the user will be looked by via +specified class. + +Meta Data: + name of class to lookup in (Optional) + +=cut + +sub _EnumLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + # SQL::Statement changes != to <>. (Can we remove this now?) + $op = "!=" if $op eq "<>"; + + die "Invalid Operation: $op for $field" + unless $op eq "=" + or $op eq "!="; + + my $meta = $FIELD_METADATA{$field}; + if ( defined $meta->[1] && defined $value && $value !~ /^\d+$/ ) { + my $class = "RT::" . $meta->[1]; + my $o = $class->new( $sb->CurrentUser ); + $o->Load($value); + $value = $o->Id || 0; + } elsif ( $field eq "Type" ) { + $value = lc $value if $value =~ /^(ticket|approval|reminder)$/i; + } elsif ($field eq "Status") { + $value = lc $value; + } + $sb->_SQLLimit( + FIELD => $field, + VALUE => $value, + OPERATOR => $op, + @rest, + ); +} + +=head2 _IntLimit + +Handle fields where the values are limited to integers. (For example, +Priority, TimeWorked.) + +Meta Data: + None + +=cut + +sub _IntLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + die "Invalid Operator $op for $field" + unless $op =~ /^(=|!=|>|<|>=|<=)$/; + + $sb->_SQLLimit( + FIELD => $field, + VALUE => $value, + OPERATOR => $op, + @rest, + ); +} + +=head2 _LinkLimit + +Handle fields which deal with links between tickets. (MemberOf, DependsOn) + +Meta Data: + 1: Direction (From, To) + 2: Link Type (MemberOf, DependsOn, RefersTo) + +=cut + +sub _LinkLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + my $meta = $FIELD_METADATA{$field}; + die "Invalid Operator $op for $field" unless $op =~ /^(=|!=|IS|IS NOT)$/io; + + my $is_negative = 0; + if ( $op eq '!=' || $op =~ /\bNOT\b/i ) { + $is_negative = 1; + } + my $is_null = 0; + $is_null = 1 if !$value || $value =~ /^null$/io; + + my $direction = $meta->[1] || ''; + my ($matchfield, $linkfield) = ('', ''); + if ( $direction eq 'To' ) { + ($matchfield, $linkfield) = ("Target", "Base"); + } + elsif ( $direction eq 'From' ) { + ($matchfield, $linkfield) = ("Base", "Target"); + } + elsif ( $direction ) { + die "Invalid link direction '$direction' for $field\n"; + } else { + $sb->_OpenParen; + $sb->_LinkLimit( 'LinkedTo', $op, $value, @rest ); + $sb->_LinkLimit( + 'LinkedFrom', $op, $value, @rest, + ENTRYAGGREGATOR => (($is_negative && $is_null) || (!$is_null && !$is_negative))? 'OR': 'AND', + ); + $sb->_CloseParen; + return; + } + + my $is_local = 1; + if ( $is_null ) { + $op = ($op =~ /^(=|IS)$/i)? 'IS': 'IS NOT'; + } + elsif ( $value =~ /\D/ ) { + $value = RT::URI->new( $sb->CurrentUser )->CanonicalizeURI( $value ); + $is_local = 0; + } + $matchfield = "Local$matchfield" if $is_local; + +#For doing a left join to find "unlinked tickets" we want to generate a query that looks like this +# SELECT main.* FROM Tickets main +# LEFT JOIN Links Links_1 ON ( (Links_1.Type = 'MemberOf') +# AND(main.id = Links_1.LocalTarget)) +# WHERE Links_1.LocalBase IS NULL; + + if ( $is_null ) { + my $linkalias = $sb->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Links', + FIELD2 => 'Local' . $linkfield + ); + $sb->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Type', + OPERATOR => '=', + VALUE => $meta->[2], + ) if $meta->[2]; + $sb->_SQLLimit( + @rest, + ALIAS => $linkalias, + FIELD => $matchfield, + OPERATOR => $op, + VALUE => 'NULL', + QUOTEVALUE => 0, + ); + } + else { + my $linkalias = $sb->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Links', + FIELD2 => 'Local' . $linkfield + ); + $sb->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Type', + OPERATOR => '=', + VALUE => $meta->[2], + ) if $meta->[2]; + $sb->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => $matchfield, + OPERATOR => '=', + VALUE => $value, + ); + $sb->_SQLLimit( + @rest, + ALIAS => $linkalias, + FIELD => $matchfield, + OPERATOR => $is_negative? 'IS': 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ); + } +} + +=head2 _DateLimit + +Handle date fields. (Created, LastTold..) + +Meta Data: + 1: type of link. (Probably not necessary.) + +=cut + +sub _DateLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + die "Invalid Date Op: $op" + unless $op =~ /^(=|>|<|>=|<=)$/; + + my $meta = $FIELD_METADATA{$field}; + die "Incorrect Meta Data for $field" + unless ( defined $meta->[1] ); + + $sb->_DateFieldLimit( $meta->[1], $op, $value, @rest ); +} + +# Factor this out for use by custom fields + +sub _DateFieldLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + my $date = RT::Date->new( $sb->CurrentUser ); + $date->Set( Format => 'unknown', Value => $value ); + + if ( $op eq "=" ) { + + # if we're specifying =, that means we want everything on a + # particular single day. in the database, we need to check for > + # and < the edges of that day. + # + # Except if the value is 'this month' or 'last month', check + # > and < the edges of the month. + + my ($daystart, $dayend); + if ( lc($value) eq 'this month' ) { + $date->SetToNow; + $date->SetToStart('month', Timezone => 'server'); + $daystart = $date->ISO; + $date->AddMonth(Timezone => 'server'); + $dayend = $date->ISO; + } + elsif ( lc($value) eq 'last month' ) { + $date->SetToNow; + $date->SetToStart('month', Timezone => 'server'); + $dayend = $date->ISO; + $date->AddDays(-1); + $date->SetToStart('month', Timezone => 'server'); + $daystart = $date->ISO; + } + else { + $date->SetToMidnight( Timezone => 'server' ); + $daystart = $date->ISO; + $date->AddDay; + $dayend = $date->ISO; + } + + $sb->_OpenParen; + + $sb->_SQLLimit( + FIELD => $field, + OPERATOR => ">=", + VALUE => $daystart, + @rest, + ); + + $sb->_SQLLimit( + FIELD => $field, + OPERATOR => "<", + VALUE => $dayend, + @rest, + ENTRYAGGREGATOR => 'AND', + ); + + $sb->_CloseParen; + + } + else { + $sb->_SQLLimit( + FIELD => $field, + OPERATOR => $op, + VALUE => $date->ISO, + @rest, + ); + } +} + +=head2 _StringLimit + +Handle simple fields which are just strings. (Subject,Type) + +Meta Data: + None + +=cut + +sub _StringLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + # FIXME: + # Valid Operators: + # =, !=, LIKE, NOT LIKE + if ( RT->Config->Get('DatabaseType') eq 'Oracle' + && (!defined $value || !length $value) + && lc($op) ne 'is' && lc($op) ne 'is not' + ) { + if ($op eq '!=' || $op =~ /^NOT\s/i) { + $op = 'IS NOT'; + } else { + $op = 'IS'; + } + $value = 'NULL'; + } + + $sb->_SQLLimit( + FIELD => $field, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + @rest, + ); +} + +=head2 _TransDateLimit + +Handle fields limiting based on Transaction Date. + +The inpupt value must be in a format parseable by Time::ParseDate + +Meta Data: + None + +=cut + +# This routine should really be factored into translimit. +sub _TransDateLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + + # See the comments for TransLimit, they apply here too + + my $txn_alias = $sb->JoinTransactions; + + my $date = RT::Date->new( $sb->CurrentUser ); + $date->Set( Format => 'unknown', Value => $value ); + + $sb->_OpenParen; + if ( $op eq "=" ) { + + # if we're specifying =, that means we want everything on a + # particular single day. in the database, we need to check for > + # and < the edges of that day. + + $date->SetToMidnight( Timezone => 'server' ); + my $daystart = $date->ISO; + $date->AddDay; + my $dayend = $date->ISO; + + $sb->_SQLLimit( + ALIAS => $txn_alias, + FIELD => 'Created', + OPERATOR => ">=", + VALUE => $daystart, + @rest + ); + $sb->_SQLLimit( + ALIAS => $txn_alias, + FIELD => 'Created', + OPERATOR => "<=", + VALUE => $dayend, + @rest, + ENTRYAGGREGATOR => 'AND', + ); + + } + + # not searching for a single day + else { + + #Search for the right field + $sb->_SQLLimit( + ALIAS => $txn_alias, + FIELD => 'Created', + OPERATOR => $op, + VALUE => $date->ISO, + @rest + ); + } + + $sb->_CloseParen; +} + +=head2 _TransLimit + +Limit based on the ContentType or the Filename of a transaction. + +=cut + +sub _TransLimit { + my ( $self, $field, $op, $value, %rest ) = @_; + + my $txn_alias = $self->JoinTransactions; + unless ( defined $self->{_sql_trattachalias} ) { + $self->{_sql_trattachalias} = $self->_SQLJoin( + TYPE => 'LEFT', # not all txns have an attachment + ALIAS1 => $txn_alias, + FIELD1 => 'id', + TABLE2 => 'Attachments', + FIELD2 => 'TransactionId', + ); + } + + $self->_SQLLimit( + %rest, + ALIAS => $self->{_sql_trattachalias}, + FIELD => $field, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ); +} + +=head2 _TransContentLimit + +Limit based on the Content of a transaction. + +=cut + +sub _TransContentLimit { + + # Content search + + # If only this was this simple. We've got to do something + # complicated here: + + #Basically, we want to make sure that the limits apply to + #the same attachment, rather than just another attachment + #for the same ticket, no matter how many clauses we lump + #on. We put them in TicketAliases so that they get nuked + #when we redo the join. + + # In the SQL, we might have + # (( Content = foo ) or ( Content = bar AND Content = baz )) + # The AND group should share the same Alias. + + # Actually, maybe it doesn't matter. We use the same alias and it + # works itself out? (er.. different.) + + # Steal more from _ProcessRestrictions + + # FIXME: Maybe look at the previous FooLimit call, and if it was a + # TransLimit and EntryAggregator == AND, reuse the Aliases? + + # Or better - store the aliases on a per subclause basis - since + # those are going to be the things we want to relate to each other, + # anyway. + + # maybe we should not allow certain kinds of aggregation of these + # clauses and do a psuedo regex instead? - the problem is getting + # them all into the same subclause when you have (A op B op C) - the + # way they get parsed in the tree they're in different subclauses. + + my ( $self, $field, $op, $value, %rest ) = @_; + $field = 'Content' if $field =~ /\W/; + + my $config = RT->Config->Get('FullTextSearch') || {}; + unless ( $config->{'Enable'} ) { + $self->_SQLLimit( %rest, FIELD => 'id', VALUE => 0 ); + return; + } + + my $txn_alias = $self->JoinTransactions; + unless ( defined $self->{_sql_trattachalias} ) { + $self->{_sql_trattachalias} = $self->_SQLJoin( + TYPE => 'LEFT', # not all txns have an attachment + ALIAS1 => $txn_alias, + FIELD1 => 'id', + TABLE2 => 'Attachments', + FIELD2 => 'TransactionId', + ); + } + + $self->_OpenParen; + if ( $config->{'Indexed'} ) { + my $db_type = RT->Config->Get('DatabaseType'); + + my $alias; + if ( $config->{'Table'} and $config->{'Table'} ne "Attachments") { + $alias = $self->{'_sql_aliases'}{'full_text'} ||= $self->_SQLJoin( + TYPE => 'LEFT', + ALIAS1 => $self->{'_sql_trattachalias'}, + FIELD1 => 'id', + TABLE2 => $config->{'Table'}, + FIELD2 => 'id', + ); + } else { + $alias = $self->{'_sql_trattachalias'}; + } + + #XXX: handle negative searches + my $index = $config->{'Column'}; + if ( $db_type eq 'Oracle' ) { + my $dbh = $RT::Handle->dbh; + my $alias = $self->{_sql_trattachalias}; + $self->_SQLLimit( + %rest, + FUNCTION => "CONTAINS( $alias.$field, ".$dbh->quote($value) .")", + OPERATOR => '>', + VALUE => 0, + QUOTEVALUE => 0, + CASESENSITIVE => 1, + ); + # this is required to trick DBIx::SB's LEFT JOINS optimizer + # into deciding that join is redundant as it is + $self->_SQLLimit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $self->{_sql_trattachalias}, + FIELD => 'Content', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + } + elsif ( $db_type eq 'Pg' ) { + my $dbh = $RT::Handle->dbh; + $self->_SQLLimit( + %rest, + ALIAS => $alias, + FIELD => $index, + OPERATOR => '@@', + VALUE => 'plainto_tsquery('. $dbh->quote($value) .')', + QUOTEVALUE => 0, + ); + } + elsif ( $db_type eq 'mysql' ) { + # XXX: We could theoretically skip the join to Attachments, + # and have Sphinx simply index and group by the TicketId, + # and join Ticket.id to that attribute, which would be much + # more efficient -- however, this is only a possibility if + # there are no other transaction limits. + + # This is a special character. Note that \ does not escape + # itself (in Sphinx 2.1.0, at least), so 'foo\;bar' becoming + # 'foo\\;bar' is not a vulnerability, and is still parsed as + # "foo, \, ;, then bar". Happily, the default mode is + # "all", meaning that boolean operators are not special. + $value =~ s/;/\\;/g; + + my $max = $config->{'MaxMatches'}; + $self->_SQLLimit( + %rest, + ALIAS => $alias, + FIELD => 'query', + OPERATOR => '=', + VALUE => "$value;limit=$max;maxmatches=$max", + ); + } + } else { + $self->_SQLLimit( + %rest, + ALIAS => $self->{_sql_trattachalias}, + FIELD => $field, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ); + } + if ( RT->Config->Get('DontSearchFileAttachments') ) { + $self->_SQLLimit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $self->{_sql_trattachalias}, + FIELD => 'Filename', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + } + $self->_CloseParen; +} + +=head2 _WatcherLimit + +Handle watcher limits. (Requestor, CC, etc..) + +Meta Data: + 1: Field to query on + + + +=cut + +sub _WatcherLimit { + my $self = shift; + my $field = shift; + my $op = shift; + my $value = shift; + my %rest = (@_); + + my $meta = $FIELD_METADATA{ $field }; + my $type = $meta->[1] || ''; + my $class = $meta->[2] || 'Ticket'; + + # Bail if the subfield is not allowed + if ( $rest{SUBKEY} + and not grep { $_ eq $rest{SUBKEY} } @{$SEARCHABLE_SUBFIELDS{'User'}}) + { + die "Invalid watcher subfield: '$rest{SUBKEY}'"; + } + + # if it's equality op and search by Email or Name then we can preload user + # we do it to help some DBs better estimate number of rows and get better plans + if ( $op =~ /^!?=$/ && (!$rest{'SUBKEY'} || $rest{'SUBKEY'} eq 'Name' || $rest{'SUBKEY'} eq 'EmailAddress') ) { + my $o = RT::User->new( $self->CurrentUser ); + my $method = + !$rest{'SUBKEY'} + ? $field eq 'Owner'? 'Load' : 'LoadByEmail' + : $rest{'SUBKEY'} eq 'EmailAddress' ? 'LoadByEmail': 'Load'; + $o->$method( $value ); + $rest{'SUBKEY'} = 'id'; + $value = $o->id || 0; + } + + # Owner was ENUM field, so "Owner = 'xxx'" allowed user to + # search by id and Name at the same time, this is workaround + # to preserve backward compatibility + if ( $field eq 'Owner' ) { + if ( ($rest{'SUBKEY'}||'') eq 'id' ) { + $self->_SQLLimit( + FIELD => 'Owner', + OPERATOR => $op, + VALUE => $value, + %rest, + ); + return; + } + } + $rest{SUBKEY} ||= 'EmailAddress'; + + my ($groups, $group_members, $users); + if ( $rest{'BUNDLE'} ) { + ($groups, $group_members, $users) = @{ $rest{'BUNDLE'} }; + } else { + $groups = $self->_RoleGroupsJoin( Type => $type, Class => $class, New => !$type ); + } + + $self->_OpenParen; + if ( $op =~ /^IS(?: NOT)?$/i ) { + # is [not] empty case + + $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); + # to avoid joining the table Users into the query, we just join GM + # and make sure we don't match records where group is member of itself + $self->SUPER::Limit( + LEFTJOIN => $group_members, + FIELD => 'GroupId', + OPERATOR => '!=', + VALUE => "$group_members.MemberId", + QUOTEVALUE => 0, + ); + $self->_SQLLimit( + ALIAS => $group_members, + FIELD => 'GroupId', + OPERATOR => $op, + VALUE => $value, + %rest, + ); + } + elsif ( $op =~ /^!=$|^NOT\s+/i ) { + # negative condition case + + # reverse op + $op =~ s/!|NOT\s+//i; + + # XXX: we have no way to build correct "Watcher.X != 'Y'" when condition + # "X = 'Y'" matches more then one user so we try to fetch two records and + # do the right thing when there is only one exist and semi-working solution + # otherwise. + my $users_obj = RT::Users->new( $self->CurrentUser ); + $users_obj->Limit( + FIELD => $rest{SUBKEY}, + OPERATOR => $op, + VALUE => $value, + ); + $users_obj->OrderBy; + $users_obj->RowsPerPage(2); + my @users = @{ $users_obj->ItemsArrayRef }; + + $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); + if ( @users <= 1 ) { + my $uid = 0; + $uid = $users[0]->id if @users; + $self->SUPER::Limit( + LEFTJOIN => $group_members, + ALIAS => $group_members, + FIELD => 'MemberId', + VALUE => $uid, + ); + $self->_SQLLimit( + %rest, + ALIAS => $group_members, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + } else { + $self->SUPER::Limit( + LEFTJOIN => $group_members, + FIELD => 'GroupId', + OPERATOR => '!=', + VALUE => "$group_members.MemberId", + QUOTEVALUE => 0, + ); + $users ||= $self->Join( + TYPE => 'LEFT', + ALIAS1 => $group_members, + FIELD1 => 'MemberId', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + $self->SUPER::Limit( + LEFTJOIN => $users, + ALIAS => $users, + FIELD => $rest{SUBKEY}, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ); + $self->_SQLLimit( + %rest, + ALIAS => $users, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + } + } else { + # positive condition case + + $group_members ||= $self->_GroupMembersJoin( + GroupsAlias => $groups, New => 1, Left => 0 + ); + $users ||= $self->Join( + TYPE => 'LEFT', + ALIAS1 => $group_members, + FIELD1 => 'MemberId', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + $self->_SQLLimit( + %rest, + ALIAS => $users, + FIELD => $rest{'SUBKEY'}, + VALUE => $value, + OPERATOR => $op, + CASESENSITIVE => 0, + ); + } + $self->_CloseParen; + return ($groups, $group_members, $users); +} + +sub _RoleGroupsJoin { + my $self = shift; + my %args = (New => 0, Class => 'Ticket', Type => '', @_); + return $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } + if $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } + && !$args{'New'}; + + # we always have watcher groups for ticket, so we use INNER join + my $groups = $self->Join( + ALIAS1 => 'main', + FIELD1 => $args{'Class'} eq 'Queue'? 'Queue': 'id', + TABLE2 => 'Groups', + FIELD2 => 'Instance', + ENTRYAGGREGATOR => 'AND', + ); + $self->SUPER::Limit( + LEFTJOIN => $groups, + ALIAS => $groups, + FIELD => 'Domain', + VALUE => 'RT::'. $args{'Class'} .'-Role', + ); + $self->SUPER::Limit( + LEFTJOIN => $groups, + ALIAS => $groups, + FIELD => 'Type', + VALUE => $args{'Type'}, + ) if $args{'Type'}; + + $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } = $groups + unless $args{'New'}; + + return $groups; +} + +sub _GroupMembersJoin { + my $self = shift; + my %args = (New => 1, GroupsAlias => undef, Left => 1, @_); + + return $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } + if $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } + && !$args{'New'}; + + my $alias = $self->Join( + $args{'Left'} ? (TYPE => 'LEFT') : (), + ALIAS1 => $args{'GroupsAlias'}, + FIELD1 => 'id', + TABLE2 => 'CachedGroupMembers', + FIELD2 => 'GroupId', + ENTRYAGGREGATOR => 'AND', + ); + $self->SUPER::Limit( + $args{'Left'} ? (LEFTJOIN => $alias) : (), + ALIAS => $alias, + FIELD => 'Disabled', + VALUE => 0, + ); + + $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } = $alias + unless $args{'New'}; + + return $alias; +} + +=head2 _WatcherJoin + +Helper function which provides joins to a watchers table both for limits +and for ordering. + +=cut + +sub _WatcherJoin { + my $self = shift; + my $type = shift || ''; + + + my $groups = $self->_RoleGroupsJoin( Type => $type ); + my $group_members = $self->_GroupMembersJoin( GroupsAlias => $groups ); + # XXX: work around, we must hide groups that + # are members of the role group we search in, + # otherwise them result in wrong NULLs in Users + # table and break ordering. Now, we know that + # RT doesn't allow to add groups as members of the + # ticket roles, so we just hide entries in CGM table + # with MemberId == GroupId from results + $self->SUPER::Limit( + LEFTJOIN => $group_members, + FIELD => 'GroupId', + OPERATOR => '!=', + VALUE => "$group_members.MemberId", + QUOTEVALUE => 0, + ); + my $users = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $group_members, + FIELD1 => 'MemberId', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + return ($groups, $group_members, $users); +} + +=head2 _WatcherMembershipLimit + +Handle watcher membership limits, i.e. whether the watcher belongs to a +specific group or not. + +Meta Data: + 1: Field to query on + +SELECT DISTINCT main.* +FROM + Tickets main, + Groups Groups_1, + CachedGroupMembers CachedGroupMembers_2, + Users Users_3 +WHERE ( + (main.EffectiveId = main.id) +) AND ( + (main.Status != 'deleted') +) AND ( + (main.Type = 'ticket') +) AND ( + ( + (Users_3.EmailAddress = '22') + AND + (Groups_1.Domain = 'RT::Ticket-Role') + AND + (Groups_1.Type = 'RequestorGroup') + ) +) AND + Groups_1.Instance = main.id +AND + Groups_1.id = CachedGroupMembers_2.GroupId +AND + CachedGroupMembers_2.MemberId = Users_3.id +ORDER BY main.id ASC +LIMIT 25 + +=cut + +sub _WatcherMembershipLimit { + my ( $self, $field, $op, $value, @rest ) = @_; + my %rest = @rest; + + $self->_OpenParen; + + my $groups = $self->NewAlias('Groups'); + my $groupmembers = $self->NewAlias('CachedGroupMembers'); + my $users = $self->NewAlias('Users'); + my $memberships = $self->NewAlias('CachedGroupMembers'); + + if ( ref $field ) { # gross hack + my @bundle = @$field; + $self->_OpenParen; + for my $chunk (@bundle) { + ( $field, $op, $value, @rest ) = @$chunk; + $self->_SQLLimit( + ALIAS => $memberships, + FIELD => 'GroupId', + VALUE => $value, + OPERATOR => $op, + @rest, + ); + } + $self->_CloseParen; + } + else { + $self->_SQLLimit( + ALIAS => $memberships, + FIELD => 'GroupId', + VALUE => $value, + OPERATOR => $op, + @rest, + ); + } + + # Tie to groups for tickets we care about + $self->_SQLLimit( + ALIAS => $groups, + FIELD => 'Domain', + VALUE => 'RT::Ticket-Role', + ENTRYAGGREGATOR => 'AND' + ); + + $self->Join( + ALIAS1 => $groups, + FIELD1 => 'Instance', + ALIAS2 => 'main', + FIELD2 => 'id' + ); + + # }}} + + # If we care about which sort of watcher + my $meta = $FIELD_METADATA{$field}; + my $type = ( defined $meta->[1] ? $meta->[1] : undef ); + + if ($type) { + $self->_SQLLimit( + ALIAS => $groups, + FIELD => 'Type', + VALUE => $type, + ENTRYAGGREGATOR => 'AND' + ); + } + + $self->Join( + ALIAS1 => $groups, + FIELD1 => 'id', + ALIAS2 => $groupmembers, + FIELD2 => 'GroupId' + ); + + $self->Join( + ALIAS1 => $groupmembers, + FIELD1 => 'MemberId', + ALIAS2 => $users, + FIELD2 => 'id' + ); + + $self->Limit( + ALIAS => $groupmembers, + FIELD => 'Disabled', + VALUE => 0, + ); + + $self->Join( + ALIAS1 => $memberships, + FIELD1 => 'MemberId', + ALIAS2 => $users, + FIELD2 => 'id' + ); + + $self->Limit( + ALIAS => $memberships, + FIELD => 'Disabled', + VALUE => 0, + ); + + + $self->_CloseParen; + +} + +=head2 _CustomFieldDecipher + +Try and turn a CF descriptor into (cfid, cfname) object pair. + +Takes an optional second parameter of the CF LookupType, defaults to Ticket CFs. + +=cut + +sub _CustomFieldDecipher { + my ($self, $string, $lookuptype) = @_; + $lookuptype ||= $self->_SingularClass->CustomFieldLookupType; + + my ($object, $field, $column) = ($string =~ /^(?:(.+?)\.)?\{(.+)\}(?:\.(Content|LargeContent))?$/); + $field ||= ($string =~ /^{(.*?)}$/)[0] || $string; + + my ($cf, $applied_to); + + if ( $object ) { + my $record_class = RT::CustomField->RecordClassFromLookupType($lookuptype); + $applied_to = $record_class->new( $self->CurrentUser ); + $applied_to->Load( $object ); + + if ( $applied_to->id ) { + RT->Logger->debug("Limiting to CFs identified by '$field' applied to $record_class #@{[$applied_to->id]} (loaded via '$object')"); + } + else { + RT->Logger->warning("$record_class '$object' doesn't exist, parsed from '$string'"); + $object = 0; + undef $applied_to; + } + } + + if ( $field =~ /\D/ ) { + $object ||= ''; + my $cfs = RT::CustomFields->new( $self->CurrentUser ); + $cfs->Limit( FIELD => 'Name', VALUE => $field, ($applied_to ? (CASESENSITIVE => 0) : ()) ); + $cfs->LimitToLookupType($lookuptype); + + if ($applied_to) { + $cfs->SetContextObject($applied_to); + $cfs->LimitToObjectId($applied_to->id); + } + + # if there is more then one field the current user can + # see with the same name then we shouldn't return cf object + # as we don't know which one to use + $cf = $cfs->First; + if ( $cf ) { + $cf = undef if $cfs->Next; + } + } + else { + $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->Load( $field ); + $cf->SetContextObject($applied_to) + if $cf->id and $applied_to; + } + + return ($object, $field, $cf, $column); +} + +=head2 _CustomFieldJoin + +Factor out the Join of custom fields so we can use it for sorting too + +=cut + +our %JOIN_ALIAS_FOR_LOOKUP_TYPE = ( + RT::Ticket->CustomFieldLookupType => sub { "main" }, +); + +sub _CustomFieldJoin { + my ($self, $cfkey, $cfid, $field, $type) = @_; + $type ||= RT::Ticket->CustomFieldLookupType; + + # Perform one Join per CustomField + if ( $self->{_sql_object_cfv_alias}{$cfkey} || + $self->{_sql_cf_alias}{$cfkey} ) + { + return ( $self->{_sql_object_cfv_alias}{$cfkey}, + $self->{_sql_cf_alias}{$cfkey} ); + } + + my $ObjectAlias = $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type} + ? $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type}->($self) + : die "We don't know how to join on $type"; + + my ($ObjectCFs, $CFs); + if ( $cfid ) { + $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $ObjectAlias, + FIELD1 => 'id', + TABLE2 => 'ObjectCustomFieldValues', + FIELD2 => 'ObjectId', + ); + $self->SUPER::Limit( + LEFTJOIN => $ObjectCFs, + FIELD => 'CustomField', + VALUE => $cfid, + ENTRYAGGREGATOR => 'AND' + ); + } + else { + my $ocfalias = $self->Join( + TYPE => 'LEFT', + FIELD1 => 'Queue', + TABLE2 => 'ObjectCustomFields', + FIELD2 => 'ObjectId', + ); + + $self->SUPER::Limit( + LEFTJOIN => $ocfalias, + ENTRYAGGREGATOR => 'OR', + FIELD => 'ObjectId', + VALUE => '0', + ); + + $CFs = $self->{_sql_cf_alias}{$cfkey} = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $ocfalias, + FIELD1 => 'CustomField', + TABLE2 => 'CustomFields', + FIELD2 => 'id', + ); + $self->SUPER::Limit( + LEFTJOIN => $CFs, + ENTRYAGGREGATOR => 'AND', + FIELD => 'LookupType', + VALUE => $type, + ); + $self->SUPER::Limit( + LEFTJOIN => $CFs, + ENTRYAGGREGATOR => 'AND', + FIELD => 'Name', + VALUE => $field, + ); + + $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $CFs, + FIELD1 => 'id', + TABLE2 => 'ObjectCustomFieldValues', + FIELD2 => 'CustomField', + ); + $self->SUPER::Limit( + LEFTJOIN => $ObjectCFs, + FIELD => 'ObjectId', + VALUE => "$ObjectAlias.id", + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'AND', + ); + } + + $self->SUPER::Limit( + LEFTJOIN => $ObjectCFs, + FIELD => 'ObjectType', + VALUE => RT::CustomField->ObjectTypeFromLookupType($type), + ENTRYAGGREGATOR => 'AND' + ); + $self->SUPER::Limit( + LEFTJOIN => $ObjectCFs, + FIELD => 'Disabled', + OPERATOR => '=', + VALUE => '0', + ENTRYAGGREGATOR => 'AND' + ); + + return ($ObjectCFs, $CFs); +} + +=head2 _CustomFieldLimit + +Limit based on CustomFields + +Meta Data: + none + +=cut + +use Regexp::Common qw(RE_net_IPv4); +use Regexp::Common::net::CIDR; + + +sub _CustomFieldLimit { + my ( $self, $_field, $op, $value, %rest ) = @_; + + my $meta = $FIELD_METADATA{ $_field }; + my $class = $meta->[1] || 'Ticket'; + my $type = "RT::$class"->CustomFieldLookupType; + + my $field = $rest{'SUBKEY'} || die "No field specified"; + + # For our sanity, we can only limit on one queue at a time + + my ($object, $cfid, $cf, $column); + ($object, $field, $cf, $column) = $self->_CustomFieldDecipher( $field, $type ); + $cfid = $cf ? $cf->id : 0 ; + +# If we're trying to find custom fields that don't match something, we +# want tickets where the custom field has no value at all. Note that +# we explicitly don't include the "IS NULL" case, since we would +# otherwise end up with a redundant clause. + + my ($negative_op, $null_op, $inv_op, $range_op) + = $self->ClassifySQLOperation( $op ); + + my $fix_op = sub { + return @_ unless RT->Config->Get('DatabaseType') eq 'Oracle'; + + my %args = @_; + return %args unless $args{'FIELD'} eq 'LargeContent'; + + my $op = $args{'OPERATOR'}; + if ( $op eq '=' ) { + $args{'OPERATOR'} = 'MATCHES'; + } + elsif ( $op eq '!=' ) { + $args{'OPERATOR'} = 'NOT MATCHES'; + } + elsif ( $op =~ /^[<>]=?$/ ) { + $args{'FUNCTION'} = "TO_CHAR( $args{'ALIAS'}.LargeContent )"; + } + return %args; + }; + + if ( $cf && $cf->Type eq 'IPAddress' ) { + my $parsed = RT::ObjectCustomFieldValue->ParseIP($value); + if ($parsed) { + $value = $parsed; + } + else { + $RT::Logger->warn("$value is not a valid IPAddress"); + } + } + + if ( $cf && $cf->Type eq 'IPAddressRange' ) { + my ( $start_ip, $end_ip ) = + RT::ObjectCustomFieldValue->ParseIPRange($value); + if ( $start_ip && $end_ip ) { + if ( $op =~ /^([<>])=?$/ ) { + my $is_less = $1 eq '<' ? 1 : 0; + if ( $is_less ) { + $value = $start_ip; + } + else { + $value = $end_ip; + } + } + else { + $value = join '-', $start_ip, $end_ip; + } + } + else { + $RT::Logger->warn("$value is not a valid IPAddressRange"); + } + } + + if ( $cf && $cf->Type =~ /^Date(?:Time)?$/ ) { + my $date = RT::Date->new( $self->CurrentUser ); + $date->Set( Format => 'unknown', Value => $value ); + if ( $date->Unix ) { + + if ( + $cf->Type eq 'Date' + || $value =~ /^\s*(?:today|tomorrow|yesterday)\s*$/i + || ( $value !~ /midnight|\d+:\d+:\d+/i + && $date->Time( Timezone => 'user' ) eq '00:00:00' ) + ) + { + $value = $date->Date( Timezone => 'user' ); + } + else { + $value = $date->DateTime; + } + } + else { + $RT::Logger->warn("$value is not a valid date string"); + } + } + + my $single_value = !$cf || !$cfid || $cf->SingleValue; + + my $cfkey = $cfid ? $cfid : "$type-$object.$field"; + + if ( $null_op && !$column ) { + # IS[ NOT] NULL without column is the same as has[ no] any CF value, + # we can reuse our default joins for this operation + # with column specified we have different situation + my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); + $self->_OpenParen; + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'id', + OPERATOR => $op, + VALUE => $value, + %rest + ); + $self->_SQLLimit( + ALIAS => $CFs, + FIELD => 'Name', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'AND', + ) if $CFs; + $self->_CloseParen; + } + elsif ( $op !~ /^[<>]=?$/ && ( $cf && $cf->Type eq 'IPAddressRange')) { + + my ($start_ip, $end_ip) = split /-/, $value; + + $self->_OpenParen; + if ( $op !~ /NOT|!=|<>/i ) { # positive equation + $self->_CustomFieldLimit( + $_field, '<=', $end_ip, %rest, + SUBKEY => $rest{'SUBKEY'}. '.Content', + ); + $self->_CustomFieldLimit( + $_field, '>=', $start_ip, %rest, + SUBKEY => $rest{'SUBKEY'}. '.LargeContent', + ENTRYAGGREGATOR => 'AND', + ); + # as well limit borders so DB optimizers can use better + # estimations and scan less rows +# have to disable this tweak because of ipv6 +# $self->_CustomFieldLimit( +# $_field, '>=', '000.000.000.000', %rest, +# SUBKEY => $rest{'SUBKEY'}. '.Content', +# ENTRYAGGREGATOR => 'AND', +# ); +# $self->_CustomFieldLimit( +# $_field, '<=', '255.255.255.255', %rest, +# SUBKEY => $rest{'SUBKEY'}. '.LargeContent', +# ENTRYAGGREGATOR => 'AND', +# ); + } + else { # negative equation + $self->_CustomFieldLimit($_field, '>', $end_ip, %rest); + $self->_CustomFieldLimit( + $_field, '<', $start_ip, %rest, + SUBKEY => $rest{'SUBKEY'}. '.LargeContent', + ENTRYAGGREGATOR => 'OR', + ); + # TODO: as well limit borders so DB optimizers can use better + # estimations and scan less rows, but it's harder to do + # as we have OR aggregator + } + $self->_CloseParen; + } + elsif ( !$negative_op || $single_value ) { + $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++ if !$single_value && !$range_op; + my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); + + $self->_OpenParen; + + $self->_OpenParen; + + $self->_OpenParen; + # if column is defined then deal only with it + # otherwise search in Content and in LargeContent + if ( $column ) { + $self->_SQLLimit( $fix_op->( + ALIAS => $ObjectCFs, + FIELD => $column, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + %rest + ) ); + $self->_CloseParen; + $self->_CloseParen; + $self->_CloseParen; + } + else { + # need special treatment for Date + if ( $cf and $cf->Type eq 'DateTime' and $op eq '=' && $value !~ /:/ ) { + # no time specified, that means we want everything on a + # particular day. in the database, we need to check for > + # and < the edges of that day. + my $date = RT::Date->new( $self->CurrentUser ); + $date->Set( Format => 'unknown', Value => $value ); + my $daystart = $date->ISO; + $date->AddDay; + my $dayend = $date->ISO; + + $self->_OpenParen; + + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => ">=", + VALUE => $daystart, + %rest, + ); + + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => "<", + VALUE => $dayend, + %rest, + ENTRYAGGREGATOR => 'AND', + ); + + $self->_CloseParen; + } + elsif ( $op eq '=' || $op eq '!=' || $op eq '<>' ) { + if ( length( Encode::encode_utf8($value) ) < 256 ) { + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + %rest + ); + } + else { + $self->_OpenParen; + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => '=', + VALUE => '', + ENTRYAGGREGATOR => 'OR' + ); + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => 'IS', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'OR' + ); + $self->_CloseParen; + $self->_SQLLimit( $fix_op->( + ALIAS => $ObjectCFs, + FIELD => 'LargeContent', + OPERATOR => $op, + VALUE => $value, + ENTRYAGGREGATOR => 'AND', + CASESENSITIVE => 0, + ) ); + } + } + else { + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + %rest + ); + + $self->_OpenParen; + $self->_OpenParen; + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => '=', + VALUE => '', + ENTRYAGGREGATOR => 'OR' + ); + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => 'IS', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'OR' + ); + $self->_CloseParen; + $self->_SQLLimit( $fix_op->( + ALIAS => $ObjectCFs, + FIELD => 'LargeContent', + OPERATOR => $op, + VALUE => $value, + ENTRYAGGREGATOR => 'AND', + CASESENSITIVE => 0, + ) ); + $self->_CloseParen; + } + $self->_CloseParen; + + # XXX: if we join via CustomFields table then + # because of order of left joins we get NULLs in + # CF table and then get nulls for those records + # in OCFVs table what result in wrong results + # as decifer method now tries to load a CF then + # we fall into this situation only when there + # are more than one CF with the name in the DB. + # the same thing applies to order by call. + # TODO: reorder joins T <- OCFVs <- CFs <- OCFs if + # we want treat IS NULL as (not applies or has + # no value) + $self->_SQLLimit( + ALIAS => $CFs, + FIELD => 'Name', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'AND', + ) if $CFs; + $self->_CloseParen; + + if ($negative_op) { + $self->_SQLLimit( + ALIAS => $ObjectCFs, + FIELD => $column || 'Content', + OPERATOR => 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'OR', + ); + } + + $self->_CloseParen; + } + } + else { + $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++; + my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); + + # reverse operation + $op =~ s/!|NOT\s+//i; + + # if column is defined then deal only with it + # otherwise search in Content and in LargeContent + if ( $column ) { + $self->SUPER::Limit( $fix_op->( + LEFTJOIN => $ObjectCFs, + ALIAS => $ObjectCFs, + FIELD => $column, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ) ); + } + else { + $self->SUPER::Limit( + LEFTJOIN => $ObjectCFs, + ALIAS => $ObjectCFs, + FIELD => 'Content', + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ); + } + $self->_SQLLimit( + %rest, + ALIAS => $ObjectCFs, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ); + } +} + +sub _HasAttributeLimit { + my ( $self, $field, $op, $value, %rest ) = @_; + + my $alias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Attributes', + FIELD2 => 'ObjectId', + ); + $self->SUPER::Limit( + LEFTJOIN => $alias, + FIELD => 'ObjectType', + VALUE => 'RT::Ticket', + ENTRYAGGREGATOR => 'AND' + ); + $self->SUPER::Limit( + LEFTJOIN => $alias, + FIELD => 'Name', + OPERATOR => $op, + VALUE => $value, + ENTRYAGGREGATOR => 'AND' + ); + $self->_SQLLimit( + %rest, + ALIAS => $alias, + FIELD => 'id', + OPERATOR => $FIELD_METADATA{$field}->[1]? 'IS NOT': 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ); +} + +# End Helper Functions + +# End of SQL Stuff ------------------------------------------------- + + +=head2 OrderByCols ARRAY + +A modified version of the OrderBy method which automatically joins where +C<ALIAS> is set to the name of a watcher type. + +=cut + +sub OrderByCols { + my $self = shift; + my @args = @_; + my $clause; + my @res = (); + my $order = 0; + + foreach my $row (@args) { + if ( $row->{ALIAS} ) { + push @res, $row; + next; + } + if ( $row->{FIELD} !~ /\./ ) { + my $meta = $self->FIELDS->{ $row->{FIELD} }; + unless ( $meta ) { + push @res, $row; + next; + } + + if ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'Queue' ) { + my $alias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => $row->{'FIELD'}, + TABLE2 => 'Queues', + FIELD2 => 'id', + ); + push @res, { %$row, ALIAS => $alias, FIELD => "Name" }; + } elsif ( ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'User' ) + || ( $meta->[0] eq 'WATCHERFIELD' && ($meta->[1]||'') eq 'Owner' ) + ) { + my $alias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => $row->{'FIELD'}, + TABLE2 => 'Users', + FIELD2 => 'id', + ); + push @res, { %$row, ALIAS => $alias, FIELD => "Name" }; + } else { + push @res, $row; + } + next; + } + + my ( $field, $subkey ) = split /\./, $row->{FIELD}, 2; + my $meta = $self->FIELDS->{$field}; + if ( defined $meta->[0] && $meta->[0] eq 'WATCHERFIELD' ) { + # cache alias as we want to use one alias per watcher type for sorting + my $users = $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] }; + unless ( $users ) { + $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] } + = $users = ( $self->_WatcherJoin( $meta->[1] ) )[2]; + } + push @res, { %$row, ALIAS => $users, FIELD => $subkey }; + } elsif ( defined $meta->[0] && $meta->[0] eq 'CUSTOMFIELD' ) { + my ($object, $field, $cf_obj, $column) = $self->_CustomFieldDecipher( $subkey ); + my $cfkey = $cf_obj ? $cf_obj->id : "$object.$field"; + $cfkey .= ".ordering" if !$cf_obj || ($cf_obj->MaxValues||0) != 1; + my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, ($cf_obj ?$cf_obj->id :0) , $field ); + # this is described in _CustomFieldLimit + $self->_SQLLimit( + ALIAS => $CFs, + FIELD => 'Name', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 1, + ENTRYAGGREGATOR => 'AND', + ) if $CFs; + unless ($cf_obj) { + # For those cases where we are doing a join against the + # CF name, and don't have a CFid, use Unique to make sure + # we don't show duplicate tickets. NOTE: I'm pretty sure + # this will stay mixed in for the life of the + # class/package, and not just for the life of the object. + # Potential performance issue. + require DBIx::SearchBuilder::Unique; + DBIx::SearchBuilder::Unique->import; + } + my $CFvs = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $ObjectCFs, + FIELD1 => 'CustomField', + TABLE2 => 'CustomFieldValues', + FIELD2 => 'CustomField', + ); + $self->SUPER::Limit( + LEFTJOIN => $CFvs, + FIELD => 'Name', + QUOTEVALUE => 0, + VALUE => $ObjectCFs . ".Content", + ENTRYAGGREGATOR => 'AND' + ); + + push @res, { %$row, ALIAS => $CFvs, FIELD => 'SortOrder' }; + push @res, { %$row, ALIAS => $ObjectCFs, FIELD => 'Content' }; + } elsif ( $field eq "Custom" && $subkey eq "Ownership") { + # PAW logic is "reversed" + my $order = "ASC"; + if (exists $row->{ORDER} ) { + my $o = $row->{ORDER}; + delete $row->{ORDER}; + $order = "DESC" if $o =~ /asc/i; + } + + # Ticket.Owner 1 0 X + # Unowned Tickets 0 1 X + # Else 0 0 X + + foreach my $uid ( $self->CurrentUser->Id, RT->Nobody->Id ) { + if ( RT->Config->Get('DatabaseType') eq 'Oracle' ) { + my $f = ($row->{'ALIAS'} || 'main') .'.Owner'; + push @res, { + %$row, + FIELD => undef, + ALIAS => '', + FUNCTION => "CASE WHEN $f=$uid THEN 1 ELSE 0 END", + ORDER => $order + }; + } else { + push @res, { + %$row, + FIELD => undef, + FUNCTION => "Owner=$uid", + ORDER => $order + }; + } + } + + push @res, { %$row, FIELD => "Priority", ORDER => $order } ; + + } elsif ( $field eq 'Customer' ) { #Freeside + # OrderBy(FIELD => expression) doesn't work, it has to be + # an actual field, so we have to do the join even if sorting + # by custnum + my $custalias = $self->JoinToCustomer; + my $cust_field = lc($subkey); + if ( !$cust_field or $cust_field eq 'number' ) { + $cust_field = 'custnum'; + } + elsif ( $cust_field eq 'name' ) { + $cust_field = "COALESCE( $custalias.company, + $custalias.last || ', ' || $custalias.first + )"; + } + else { # order by cust_main fields directly: 'Customer.agentnum' + $cust_field = $subkey; + } + push @res, { %$row, ALIAS => $custalias, FIELD => $cust_field }; + + } elsif ( $field eq 'Service' ) { + + my $svcalias = $self->JoinToService; + my $svc_field = lc($subkey); + if ( !$svc_field or $svc_field eq 'number' ) { + $svc_field = 'svcnum'; + } + push @res, { %$row, ALIAS => $svcalias, FIELD => $svc_field }; + + } #Freeside + + else { + push @res, $row; + } + } + return $self->SUPER::OrderByCols(@res); +} + +#Freeside + +sub JoinToCustLinks { + # Set up join to links (id = localbase), + # limit link type to 'MemberOf', + # and target value to any Freeside custnum URI. + # Return the linkalias for further join/limit action, + # and an sql expression to retrieve the custnum. + my $self = shift; + # only join once for each RT::Tickets object + my $linkalias = $self->{cust_main_linkalias}; + if (!$linkalias) { + $linkalias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Links', + FIELD2 => 'LocalBase', + ); + $self->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Base', + OPERATOR => 'LIKE', + VALUE => 'fsck.com-rt://%/ticket/%', + ); + $self->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Type', + OPERATOR => '=', + VALUE => 'MemberOf', + ); + $self->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Target', + OPERATOR => 'STARTSWITH', + VALUE => 'freeside://freeside/cust_main/', + ); + $self->{cust_main_linkalias} = $linkalias; + } + my $custnum_sql = "CAST(SUBSTR($linkalias.Target,31) AS "; + if ( RT->Config->Get('DatabaseType') eq 'mysql' ) { + $custnum_sql .= 'SIGNED INTEGER)'; + } + else { + $custnum_sql .= 'INTEGER)'; + } + return ($linkalias, $custnum_sql); +} + +sub JoinToCustomer { + my $self = shift; + my ($linkalias, $custnum_sql) = $self->JoinToCustLinks; + # don't reuse this join, though--negative queries need + # independent joins + my $custalias = $self->Join( + TYPE => 'LEFT', + EXPRESSION => $custnum_sql, + TABLE2 => 'cust_main', + FIELD2 => 'custnum', + ); + return $custalias; +} + +sub JoinToSvcLinks { + my $self = shift; + my $linkalias = $self->{cust_svc_linkalias}; + if (!$linkalias) { + $linkalias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Links', + FIELD2 => 'LocalBase', + ); + $self->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Base', + OPERATOR => 'LIKE', + VALUE => 'fsck.com-rt://%/ticket/%', + ); + + $self->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Type', + OPERATOR => '=', + VALUE => 'MemberOf', + ); + $self->SUPER::Limit( + LEFTJOIN => $linkalias, + FIELD => 'Target', + OPERATOR => 'STARTSWITH', + VALUE => 'freeside://freeside/cust_svc/', + ); + $self->{cust_svc_linkalias} = $linkalias; + } + my $svcnum_sql = "CAST(SUBSTR($linkalias.Target,30) AS "; + if ( RT->Config->Get('DatabaseType') eq 'mysql' ) { + $svcnum_sql .= 'SIGNED INTEGER)'; + } + else { + $svcnum_sql .= 'INTEGER)'; + } + return ($linkalias, $svcnum_sql); +} + +sub JoinToService { + my $self = shift; + my ($linkalias, $svcnum_sql) = $self->JoinToSvcLinks; + $self->Join( + TYPE => 'LEFT', + EXPRESSION => $svcnum_sql, + TABLE2 => 'cust_svc', + FIELD2 => 'svcnum', + ); +} + +# This creates an alternate left join path to cust_main via cust_svc. +# _FreesideFieldLimit needs to add this as a separate, independent join +# and include all tickets that have a matching cust_main record via +# either path. +sub JoinToCustomerViaService { + my $self = shift; + my $svcalias = $self->JoinToService; + my $cust_pkg = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $svcalias, + FIELD1 => 'pkgnum', + TABLE2 => 'cust_pkg', + FIELD2 => 'pkgnum', + ); + my $cust_main = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $cust_pkg, + FIELD1 => 'custnum', + TABLE2 => 'cust_main', + FIELD2 => 'custnum', + ); + $cust_main; +} + +sub _FreesideFieldLimit { + my ( $self, $field, $op, $value, %rest ) = @_; + my $is_negative = 0; + if ( $op eq '!=' || $op =~ /\bNOT\b/i ) { + # if the op is negative, do the join as though + # the op were positive, then accept only records + # where the right-side join key is null. + $is_negative = 1; + $op = '=' if $op eq '!='; + $op =~ s/\bNOT\b//; + } + + my (@alias, $table2, $subfield, $pkey); + if ( $field eq 'Customer' ) { + push @alias, $self->JoinToCustomer; + push @alias, $self->JoinToCustomerViaService; + $pkey = 'custnum'; + } + elsif ( $field eq 'Service' ) { + push @alias, $self->JoinToService; + $pkey = 'svcnum'; + } + else { + die "malformed Freeside query: $field"; + } + + $subfield = $rest{SUBKEY} || $pkey; + # compound subkey: separate into table name and field in that table + # (must be linked by custnum) + $subfield = lc($subfield); + ($table2, $subfield) = ($1, $2) if $subfield =~ /^(\w+)?\.(\w+)$/; + $subfield = $pkey if $subfield eq 'number'; + + # if it's compound, create a join from cust_main or cust_svc to that + # table, using custnum or svcnum, and Limit on that table instead. + my @_SQLLimit = (); + foreach my $a (@alias) { + if ( $table2 ) { + $a = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $a, + FIELD1 => $pkey, + TABLE2 => $table2, + FIELD2 => $pkey, + ); + } + + # do the actual Limit + $self->SUPER::Limit( + LEFTJOIN => $a, + FIELD => $subfield, + OPERATOR => $op, + VALUE => $value, + ENTRYAGGREGATOR => 'AND', + # no SUBCLAUSE needed, limits on different aliases across left joins + # are inherently independent + ); + + # then, since it's a left join, exclude tickets for which there is now + # no matching record in the table we just limited on. (Or where there + # is a matching record, if $is_negative.) + # For a cust_main query (where there are two different aliases), this + # will produce a subclause: "cust_main_1.custnum IS NOT NULL OR + # cust_main_2.custnum IS NOT NULL" (or "IS NULL AND..." for a negative + # query). + #$self->_SQLLimit( + push @_SQLLimit, { + %rest, + ALIAS => $a, + FIELD => $pkey, + OPERATOR => $is_negative ? 'IS' : 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => $is_negative ? 'AND' : 'OR', + SUBCLAUSE => 'fs_limit', + }; + } + + $self->_OpenParen; + foreach my $_SQLLimit (@_SQLLimit) { + $self->_SQLLimit( %$_SQLLimit); + } + $self->_CloseParen; + +} + +#Freeside + +=head2 Limit + +Takes a paramhash with the fields FIELD, OPERATOR, VALUE and DESCRIPTION +Generally best called from LimitFoo methods + +=cut + +sub Limit { + my $self = shift; + my %args = ( + FIELD => undef, + OPERATOR => '=', + VALUE => undef, + DESCRIPTION => undef, + @_ + ); + $args{'DESCRIPTION'} = $self->loc( + "[_1] [_2] [_3]", $args{'FIELD'}, + $args{'OPERATOR'}, $args{'VALUE'} + ) + if ( !defined $args{'DESCRIPTION'} ); + + my $index = $self->_NextIndex; + +# make the TicketRestrictions hash the equivalent of whatever we just passed in; + + %{ $self->{'TicketRestrictions'}{$index} } = %args; + + $self->{'RecalcTicketLimits'} = 1; + +# If we're looking at the effective id, we don't want to append the other clause +# which limits us to tickets where id = effective id + if ( $args{'FIELD'} eq 'EffectiveId' + && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) + { + $self->{'looking_at_effective_id'} = 1; + } + + if ( $args{'FIELD'} eq 'Type' + && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) + { + $self->{'looking_at_type'} = 1; + } + + return ($index); +} + + + + +=head2 LimitQueue + +LimitQueue takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. (It defaults to =). +VALUE is a queue id or Name. + + +=cut + +sub LimitQueue { + my $self = shift; + my %args = ( + VALUE => undef, + OPERATOR => '=', + @_ + ); + + #TODO VALUE should also take queue objects + if ( defined $args{'VALUE'} && $args{'VALUE'} !~ /^\d+$/ ) { + my $queue = RT::Queue->new( $self->CurrentUser ); + $queue->Load( $args{'VALUE'} ); + $args{'VALUE'} = $queue->Id; + } + + # What if they pass in an Id? Check for isNum() and convert to + # string. + + #TODO check for a valid queue here + + $self->Limit( + FIELD => 'Queue', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( + ' ', $self->loc('Queue'), $args{'OPERATOR'}, $args{'VALUE'}, + ), + ); + +} + + + +=head2 LimitStatus + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. +VALUE is a status. + +RT adds Status != 'deleted' until object has +allow_deleted_search internal property set. +$tickets->{'allow_deleted_search'} = 1; +$tickets->LimitStatus( VALUE => 'deleted' ); + +=cut + +sub LimitStatus { + my $self = shift; + my %args = ( + OPERATOR => '=', + @_ + ); + $self->Limit( + FIELD => 'Status', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Status'), $args{'OPERATOR'}, + $self->loc( $args{'VALUE'} ) ), + ); +} + + + +=head2 IgnoreType + +If called, this search will not automatically limit the set of results found +to tickets of type "Ticket". Tickets of other types, such as "project" and +"approval" will be found. + +=cut + +sub IgnoreType { + my $self = shift; + + # Instead of faking a Limit that later gets ignored, fake up the + # fact that we're already looking at type, so that the check in + # Tickets_SQL/FromSQL goes down the right branch + + # $self->LimitType(VALUE => '__any'); + $self->{looking_at_type} = 1; +} + + + +=head2 LimitType + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=, it defaults to "=". +VALUE is a string to search for in the type of the ticket. + + + +=cut + +sub LimitType { + my $self = shift; + my %args = ( + OPERATOR => '=', + VALUE => undef, + @_ + ); + $self->Limit( + FIELD => 'Type', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Type'), $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + + + +=head2 LimitSubject + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. +VALUE is a string to search for in the subject of the ticket. + +=cut + +sub LimitSubject { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'Subject', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Subject'), $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + +# Things that can be > < = != + + +=head2 LimitId + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a ticket Id to search for + +=cut + +sub LimitId { + my $self = shift; + my %args = ( + OPERATOR => '=', + @_ + ); + + $self->Limit( + FIELD => 'id', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => + join( ' ', $self->loc('Id'), $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + +=head2 LimitPriority + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's priority against + +=cut + +sub LimitPriority { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'Priority', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Priority'), + $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + +=head2 LimitInitialPriority + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's initial priority against + + +=cut + +sub LimitInitialPriority { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'InitialPriority', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Initial Priority'), $args{'OPERATOR'}, + $args{'VALUE'}, ), + ); +} + + + +=head2 LimitFinalPriority + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's final priority against + +=cut + +sub LimitFinalPriority { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'FinalPriority', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Final Priority'), $args{'OPERATOR'}, + $args{'VALUE'}, ), + ); +} + + + +=head2 LimitTimeWorked + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's TimeWorked attribute + +=cut + +sub LimitTimeWorked { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'TimeWorked', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Time Worked'), + $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + +=head2 LimitTimeLeft + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's TimeLeft attribute + +=cut + +sub LimitTimeLeft { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'TimeLeft', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Time Left'), + $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + + + +=head2 LimitContent + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, LIKE, NOT LIKE or !=. +VALUE is a string to search for in the body of the ticket + +=cut + +sub LimitContent { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'Content', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Ticket content'), $args{'OPERATOR'}, + $args{'VALUE'}, ), + ); +} + + + +=head2 LimitFilename + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, LIKE, NOT LIKE or !=. +VALUE is a string to search for in the body of the ticket + +=cut + +sub LimitFilename { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'Filename', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Attachment filename'), $args{'OPERATOR'}, + $args{'VALUE'}, ), + ); +} + + +=head2 LimitContentType + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, LIKE, NOT LIKE or !=. +VALUE is a content type to search ticket attachments for + +=cut + +sub LimitContentType { + my $self = shift; + my %args = (@_); + $self->Limit( + FIELD => 'ContentType', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Ticket content type'), $args{'OPERATOR'}, + $args{'VALUE'}, ), + ); +} + + + + + +=head2 LimitOwner + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. +VALUE is a user id. + +=cut + +sub LimitOwner { + my $self = shift; + my %args = ( + OPERATOR => '=', + @_ + ); + + my $owner = RT::User->new( $self->CurrentUser ); + $owner->Load( $args{'VALUE'} ); + + # FIXME: check for a valid $owner + $self->Limit( + FIELD => 'Owner', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => join( ' ', + $self->loc('Owner'), $args{'OPERATOR'}, $owner->Name(), ), + ); + +} + + + + +=head2 LimitWatcher + + Takes a paramhash with the fields OPERATOR, TYPE and VALUE. + OPERATOR is one of =, LIKE, NOT LIKE or !=. + VALUE is a value to match the ticket's watcher email addresses against + TYPE is the sort of watchers you want to match against. Leave it undef if you want to search all of them + + +=cut + +sub LimitWatcher { + my $self = shift; + my %args = ( + OPERATOR => '=', + VALUE => undef, + TYPE => undef, + @_ + ); + + #build us up a description + my ( $watcher_type, $desc ); + if ( $args{'TYPE'} ) { + $watcher_type = $args{'TYPE'}; + } + else { + $watcher_type = "Watcher"; + } + + $self->Limit( + FIELD => $watcher_type, + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + TYPE => $args{'TYPE'}, + DESCRIPTION => join( ' ', + $self->loc($watcher_type), + $args{'OPERATOR'}, $args{'VALUE'}, ), + ); +} + + + + + + +=head2 LimitLinkedTo + +LimitLinkedTo takes a paramhash with two fields: TYPE and TARGET +TYPE limits the sort of link we want to search on + +TYPE = { RefersTo, MemberOf, DependsOn } + +TARGET is the id or URI of the TARGET of the link + +=cut + +sub LimitLinkedTo { + my $self = shift; + my %args = ( + TARGET => undef, + TYPE => undef, + OPERATOR => '=', + @_ + ); + + $self->Limit( + FIELD => 'LinkedTo', + BASE => undef, + TARGET => $args{'TARGET'}, + TYPE => $args{'TYPE'}, + DESCRIPTION => $self->loc( + "Tickets [_1] by [_2]", + $self->loc( $args{'TYPE'} ), + $args{'TARGET'} + ), + OPERATOR => $args{'OPERATOR'}, + ); +} + + + +=head2 LimitLinkedFrom + +LimitLinkedFrom takes a paramhash with two fields: TYPE and BASE +TYPE limits the sort of link we want to search on + + +BASE is the id or URI of the BASE of the link + +=cut + +sub LimitLinkedFrom { + my $self = shift; + my %args = ( + BASE => undef, + TYPE => undef, + OPERATOR => '=', + @_ + ); + + # translate RT2 From/To naming to RT3 TicketSQL naming + my %fromToMap = qw(DependsOn DependentOn + MemberOf HasMember + RefersTo ReferredToBy); + + my $type = $args{'TYPE'}; + $type = $fromToMap{$type} if exists( $fromToMap{$type} ); + + $self->Limit( + FIELD => 'LinkedTo', + TARGET => undef, + BASE => $args{'BASE'}, + TYPE => $type, + DESCRIPTION => $self->loc( + "Tickets [_1] [_2]", + $self->loc( $args{'TYPE'} ), + $args{'BASE'}, + ), + OPERATOR => $args{'OPERATOR'}, + ); +} + + +sub LimitMemberOf { + my $self = shift; + my $ticket_id = shift; + return $self->LimitLinkedTo( + @_, + TARGET => $ticket_id, + TYPE => 'MemberOf', + ); +} + + +sub LimitHasMember { + my $self = shift; + my $ticket_id = shift; + return $self->LimitLinkedFrom( + @_, + BASE => "$ticket_id", + TYPE => 'HasMember', + ); + +} + + + +sub LimitDependsOn { + my $self = shift; + my $ticket_id = shift; + return $self->LimitLinkedTo( + @_, + TARGET => $ticket_id, + TYPE => 'DependsOn', + ); + +} + + + +sub LimitDependedOnBy { + my $self = shift; + my $ticket_id = shift; + return $self->LimitLinkedFrom( + @_, + BASE => $ticket_id, + TYPE => 'DependentOn', + ); + +} + + + +sub LimitRefersTo { + my $self = shift; + my $ticket_id = shift; + return $self->LimitLinkedTo( + @_, + TARGET => $ticket_id, + TYPE => 'RefersTo', + ); + +} + + + +sub LimitReferredToBy { + my $self = shift; + my $ticket_id = shift; + return $self->LimitLinkedFrom( + @_, + BASE => $ticket_id, + TYPE => 'ReferredToBy', + ); +} + + + + + +=head2 LimitDate (FIELD => 'DateField', OPERATOR => $oper, VALUE => $ISODate) + +Takes a paramhash with the fields FIELD OPERATOR and VALUE. + +OPERATOR is one of > or < +VALUE is a date and time in ISO format in GMT +FIELD is one of Starts, Started, Told, Created, Resolved, LastUpdated + +There are also helper functions of the form LimitFIELD that eliminate +the need to pass in a FIELD argument. + +=cut + +sub LimitDate { + my $self = shift; + my %args = ( + FIELD => undef, + VALUE => undef, + OPERATOR => undef, + + @_ + ); + + #Set the description if we didn't get handed it above + unless ( $args{'DESCRIPTION'} ) { + $args{'DESCRIPTION'} = $args{'FIELD'} . " " + . $args{'OPERATOR'} . " " + . $args{'VALUE'} . " GMT"; + } + + $self->Limit(%args); + +} + + +sub LimitCreated { + my $self = shift; + $self->LimitDate( FIELD => 'Created', @_ ); +} + +sub LimitDue { + my $self = shift; + $self->LimitDate( FIELD => 'Due', @_ ); + +} + +sub LimitStarts { + my $self = shift; + $self->LimitDate( FIELD => 'Starts', @_ ); + +} + +sub LimitStarted { + my $self = shift; + $self->LimitDate( FIELD => 'Started', @_ ); +} + +sub LimitResolved { + my $self = shift; + $self->LimitDate( FIELD => 'Resolved', @_ ); +} + +sub LimitTold { + my $self = shift; + $self->LimitDate( FIELD => 'Told', @_ ); +} + +sub LimitLastUpdated { + my $self = shift; + $self->LimitDate( FIELD => 'LastUpdated', @_ ); +} + +# + +=head2 LimitTransactionDate (OPERATOR => $oper, VALUE => $ISODate) + +Takes a paramhash with the fields FIELD OPERATOR and VALUE. + +OPERATOR is one of > or < +VALUE is a date and time in ISO format in GMT + + +=cut + +sub LimitTransactionDate { + my $self = shift; + my %args = ( + FIELD => 'TransactionDate', + VALUE => undef, + OPERATOR => undef, + + @_ + ); + + # <20021217042756.GK28744@pallas.fsck.com> + # "Kill It" - Jesse. + + #Set the description if we didn't get handed it above + unless ( $args{'DESCRIPTION'} ) { + $args{'DESCRIPTION'} = $args{'FIELD'} . " " + . $args{'OPERATOR'} . " " + . $args{'VALUE'} . " GMT"; + } + + $self->Limit(%args); + +} + + + + +=head2 LimitCustomField + +Takes a paramhash of key/value pairs with the following keys: + +=over 4 + +=item CUSTOMFIELD - CustomField name or id. If a name is passed, an additional parameter QUEUE may also be passed to distinguish the custom field. + +=item OPERATOR - The usual Limit operators + +=item VALUE - The value to compare against + +=back + +=cut + +sub LimitCustomField { + my $self = shift; + my %args = ( + VALUE => undef, + CUSTOMFIELD => undef, + OPERATOR => '=', + DESCRIPTION => undef, + FIELD => 'CustomFieldValue', + QUOTEVALUE => 1, + @_ + ); + + my $CF = RT::CustomField->new( $self->CurrentUser ); + if ( $args{CUSTOMFIELD} =~ /^\d+$/ ) { + $CF->Load( $args{CUSTOMFIELD} ); + } + else { + $CF->LoadByNameAndQueue( + Name => $args{CUSTOMFIELD}, + Queue => $args{QUEUE} + ); + $args{CUSTOMFIELD} = $CF->Id; + } + + #If we are looking to compare with a null value. + if ( $args{'OPERATOR'} =~ /^is$/i ) { + $args{'DESCRIPTION'} + ||= $self->loc( "Custom field [_1] has no value.", $CF->Name ); + } + elsif ( $args{'OPERATOR'} =~ /^is not$/i ) { + $args{'DESCRIPTION'} + ||= $self->loc( "Custom field [_1] has a value.", $CF->Name ); + } + + # if we're not looking to compare with a null value + else { + $args{'DESCRIPTION'} ||= $self->loc( "Custom field [_1] [_2] [_3]", + $CF->Name, $args{OPERATOR}, $args{VALUE} ); + } + + if ( defined $args{'QUEUE'} && $args{'QUEUE'} =~ /\D/ ) { + my $QueueObj = RT::Queue->new( $self->CurrentUser ); + $QueueObj->Load( $args{'QUEUE'} ); + $args{'QUEUE'} = $QueueObj->Id; + } + delete $args{'QUEUE'} unless defined $args{'QUEUE'} && length $args{'QUEUE'}; + + my @rest; + @rest = ( ENTRYAGGREGATOR => 'AND' ) + if ( $CF->Type eq 'SelectMultiple' ); + + $self->Limit( + VALUE => $args{VALUE}, + FIELD => "CF" + .(defined $args{'QUEUE'}? ".$args{'QUEUE'}" : '' ) + .".{" . $CF->Name . "}", + OPERATOR => $args{OPERATOR}, + CUSTOMFIELD => 1, + @rest, + ); + + $self->{'RecalcTicketLimits'} = 1; +} + + + +=head2 _NextIndex + +Keep track of the counter for the array of restrictions + +=cut + +sub _NextIndex { + my $self = shift; + return ( $self->{'restriction_index'}++ ); +} + + + + +sub _Init { + my $self = shift; + $self->{'table'} = "Tickets"; + $self->{'RecalcTicketLimits'} = 1; + $self->{'looking_at_effective_id'} = 0; + $self->{'looking_at_type'} = 0; + $self->{'restriction_index'} = 1; + $self->{'primary_key'} = "id"; + delete $self->{'items_array'}; + delete $self->{'item_map'}; + delete $self->{'columns_to_display'}; + $self->SUPER::_Init(@_); + + $self->_InitSQL; + +} + + +sub Count { + my $self = shift; + $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 ); + return ( $self->SUPER::Count() ); +} + + +sub CountAll { + my $self = shift; + $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 ); + return ( $self->SUPER::CountAll() ); +} + + + +=head2 ItemsArrayRef + +Returns a reference to the set of all items found in this search + +=cut + +sub ItemsArrayRef { + my $self = shift; + + return $self->{'items_array'} if $self->{'items_array'}; + + my $placeholder = $self->_ItemsCounter; + $self->GotoFirstItem(); + while ( my $item = $self->Next ) { + push( @{ $self->{'items_array'} }, $item ); + } + $self->GotoItem($placeholder); + $self->{'items_array'} + = $self->ItemsOrderBy( $self->{'items_array'} ); + + return $self->{'items_array'}; +} + +sub ItemsArrayRefWindow { + my $self = shift; + my $window = shift; + + my @old = ($self->_ItemsCounter, $self->RowsPerPage, $self->FirstRow+1); + + $self->RowsPerPage( $window ); + $self->FirstRow(1); + $self->GotoFirstItem; + + my @res; + while ( my $item = $self->Next ) { + push @res, $item; + } + + $self->RowsPerPage( $old[1] ); + $self->FirstRow( $old[2] ); + $self->GotoItem( $old[0] ); + + return \@res; +} + + +sub Next { + my $self = shift; + + $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 ); + + my $Ticket = $self->SUPER::Next; + return $Ticket unless $Ticket; + + if ( $Ticket->__Value('Status') eq 'deleted' + && !$self->{'allow_deleted_search'} ) + { + return $self->Next; + } + elsif ( RT->Config->Get('UseSQLForACLChecks') ) { + # if we found a ticket with this option enabled then + # all tickets we found are ACLed, cache this fact + my $key = join ";:;", $self->CurrentUser->id, 'ShowTicket', 'RT::Ticket-'. $Ticket->id; + $RT::Principal::_ACL_CACHE->set( $key => 1 ); + return $Ticket; + } + elsif ( $Ticket->CurrentUserHasRight('ShowTicket') ) { + # has rights + return $Ticket; + } + else { + # If the user doesn't have the right to show this ticket + return $self->Next; + } +} + +sub _DoSearch { + my $self = shift; + $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks'); + return $self->SUPER::_DoSearch( @_ ); +} + +sub _DoCount { + my $self = shift; + $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks'); + return $self->SUPER::_DoCount( @_ ); +} + +sub _RolesCanSee { + my $self = shift; + + my $cache_key = 'RolesHasRight;:;ShowTicket'; + + if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) { + return %$cached; + } + + my $ACL = RT::ACL->new( RT->SystemUser ); + $ACL->Limit( FIELD => 'RightName', VALUE => 'ShowTicket' ); + $ACL->Limit( FIELD => 'PrincipalType', OPERATOR => '!=', VALUE => 'Group' ); + my $principal_alias = $ACL->Join( + ALIAS1 => 'main', + FIELD1 => 'PrincipalId', + TABLE2 => 'Principals', + FIELD2 => 'id', + ); + $ACL->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 ); + + my %res = (); + foreach my $ACE ( @{ $ACL->ItemsArrayRef } ) { + my $role = $ACE->__Value('PrincipalType'); + my $type = $ACE->__Value('ObjectType'); + if ( $type eq 'RT::System' ) { + $res{ $role } = 1; + } + elsif ( $type eq 'RT::Queue' ) { + next if $res{ $role } && !ref $res{ $role }; + push @{ $res{ $role } ||= [] }, $ACE->__Value('ObjectId'); + } + else { + $RT::Logger->error('ShowTicket right is granted on unsupported object'); + } + } + $RT::Principal::_ACL_CACHE->set( $cache_key => \%res ); + return %res; +} + +sub _DirectlyCanSeeIn { + my $self = shift; + my $id = $self->CurrentUser->id; + + my $cache_key = 'User-'. $id .';:;ShowTicket;:;DirectlyCanSeeIn'; + if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) { + return @$cached; + } + + my $ACL = RT::ACL->new( RT->SystemUser ); + $ACL->Limit( FIELD => 'RightName', VALUE => 'ShowTicket' ); + my $principal_alias = $ACL->Join( + ALIAS1 => 'main', + FIELD1 => 'PrincipalId', + TABLE2 => 'Principals', + FIELD2 => 'id', + ); + $ACL->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 ); + my $cgm_alias = $ACL->Join( + ALIAS1 => 'main', + FIELD1 => 'PrincipalId', + TABLE2 => 'CachedGroupMembers', + FIELD2 => 'GroupId', + ); + $ACL->Limit( ALIAS => $cgm_alias, FIELD => 'MemberId', VALUE => $id ); + $ACL->Limit( ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0 ); + + my @res = (); + foreach my $ACE ( @{ $ACL->ItemsArrayRef } ) { + my $type = $ACE->__Value('ObjectType'); + if ( $type eq 'RT::System' ) { + # If user is direct member of a group that has the right + # on the system then he can see any ticket + $RT::Principal::_ACL_CACHE->set( $cache_key => [-1] ); + return (-1); + } + elsif ( $type eq 'RT::Queue' ) { + push @res, $ACE->__Value('ObjectId'); + } + else { + $RT::Logger->error('ShowTicket right is granted on unsupported object'); + } + } + $RT::Principal::_ACL_CACHE->set( $cache_key => \@res ); + return @res; +} + +sub CurrentUserCanSee { + my $self = shift; + return if $self->{'_sql_current_user_can_see_applied'}; + + return $self->{'_sql_current_user_can_see_applied'} = 1 + if $self->CurrentUser->UserObj->HasRight( + Right => 'SuperUser', Object => $RT::System + ); + + my $id = $self->CurrentUser->id; + + # directly can see in all queues then we have nothing to do + my @direct_queues = $self->_DirectlyCanSeeIn; + return $self->{'_sql_current_user_can_see_applied'} = 1 + if @direct_queues && $direct_queues[0] == -1; + + my %roles = $self->_RolesCanSee; + { + my %skip = map { $_ => 1 } @direct_queues; + foreach my $role ( keys %roles ) { + next unless ref $roles{ $role }; + + my @queues = grep !$skip{$_}, @{ $roles{ $role } }; + if ( @queues ) { + $roles{ $role } = \@queues; + } else { + delete $roles{ $role }; + } + } + } + +# there is no global watchers, only queues and tickes, if at +# some point we will add global roles then it's gonna blow +# the idea here is that if the right is set globaly for a role +# and user plays this role for a queue directly not a ticket +# then we have to check in advance + if ( my @tmp = grep $_ ne 'Owner' && !ref $roles{ $_ }, keys %roles ) { + + my $groups = RT::Groups->new( RT->SystemUser ); + $groups->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role' ); + foreach ( @tmp ) { + $groups->Limit( FIELD => 'Type', VALUE => $_ ); + } + my $principal_alias = $groups->Join( + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Principals', + FIELD2 => 'id', + ); + $groups->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 ); + my $cgm_alias = $groups->Join( + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'CachedGroupMembers', + FIELD2 => 'GroupId', + ); + $groups->Limit( ALIAS => $cgm_alias, FIELD => 'MemberId', VALUE => $id ); + $groups->Limit( ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0 ); + while ( my $group = $groups->Next ) { + push @direct_queues, $group->Instance; + } + } + + unless ( @direct_queues || keys %roles ) { + $self->SUPER::Limit( + SUBCLAUSE => 'ACL', + ALIAS => 'main', + FIELD => 'id', + VALUE => 0, + ENTRYAGGREGATOR => 'AND', + ); + return $self->{'_sql_current_user_can_see_applied'} = 1; + } + + { + my $join_roles = keys %roles; + $join_roles = 0 if $join_roles == 1 && $roles{'Owner'}; + my ($role_group_alias, $cgm_alias); + if ( $join_roles ) { + $role_group_alias = $self->_RoleGroupsJoin( New => 1 ); + $cgm_alias = $self->_GroupMembersJoin( GroupsAlias => $role_group_alias ); + $self->SUPER::Limit( + LEFTJOIN => $cgm_alias, + FIELD => 'MemberId', + OPERATOR => '=', + VALUE => $id, + ); + } + my $limit_queues = sub { + my $ea = shift; + my @queues = @_; + + return unless @queues; + if ( @queues == 1 ) { + $self->SUPER::Limit( + SUBCLAUSE => 'ACL', + ALIAS => 'main', + FIELD => 'Queue', + VALUE => $_[0], + ENTRYAGGREGATOR => $ea, + ); + } else { + $self->SUPER::_OpenParen('ACL'); + foreach my $q ( @queues ) { + $self->SUPER::Limit( + SUBCLAUSE => 'ACL', + ALIAS => 'main', + FIELD => 'Queue', + VALUE => $q, + ENTRYAGGREGATOR => $ea, + ); + $ea = 'OR'; + } + $self->SUPER::_CloseParen('ACL'); + } + return 1; + }; + + $self->SUPER::_OpenParen('ACL'); + my $ea = 'AND'; + $ea = 'OR' if $limit_queues->( $ea, @direct_queues ); + while ( my ($role, $queues) = each %roles ) { + $self->SUPER::_OpenParen('ACL'); + if ( $role eq 'Owner' ) { + $self->SUPER::Limit( + SUBCLAUSE => 'ACL', + FIELD => 'Owner', + VALUE => $id, + ENTRYAGGREGATOR => $ea, + ); + } + else { + $self->SUPER::Limit( + SUBCLAUSE => 'ACL', + ALIAS => $cgm_alias, + FIELD => 'MemberId', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => $ea, + ); + $self->SUPER::Limit( + SUBCLAUSE => 'ACL', + ALIAS => $role_group_alias, + FIELD => 'Type', + VALUE => $role, + ENTRYAGGREGATOR => 'AND', + ); + } + $limit_queues->( 'AND', @$queues ) if ref $queues; + $ea = 'OR' if $ea eq 'AND'; + $self->SUPER::_CloseParen('ACL'); + } + $self->SUPER::_CloseParen('ACL'); + } + return $self->{'_sql_current_user_can_see_applied'} = 1; +} + + + + + +=head2 LoadRestrictions + +LoadRestrictions takes a string which can fully populate the TicketRestrictons hash. +TODO It is not yet implemented + +=cut + + + +=head2 DescribeRestrictions + +takes nothing. +Returns a hash keyed by restriction id. +Each element of the hash is currently a one element hash that contains DESCRIPTION which +is a description of the purpose of that TicketRestriction + +=cut + +sub DescribeRestrictions { + my $self = shift; + + my %listing; + + foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) { + $listing{$row} = $self->{'TicketRestrictions'}{$row}{'DESCRIPTION'}; + } + return (%listing); +} + + + +=head2 RestrictionValues FIELD + +Takes a restriction field and returns a list of values this field is restricted +to. + +=cut + +sub RestrictionValues { + my $self = shift; + my $field = shift; + map $self->{'TicketRestrictions'}{$_}{'VALUE'}, grep { + $self->{'TicketRestrictions'}{$_}{'FIELD'} eq $field + && $self->{'TicketRestrictions'}{$_}{'OPERATOR'} eq "=" + } + keys %{ $self->{'TicketRestrictions'} }; +} + + + +=head2 ClearRestrictions + +Removes all restrictions irretrievably + +=cut + +sub ClearRestrictions { + my $self = shift; + delete $self->{'TicketRestrictions'}; + $self->{'looking_at_effective_id'} = 0; + $self->{'looking_at_type'} = 0; + $self->{'RecalcTicketLimits'} = 1; +} + + + +=head2 DeleteRestriction + +Takes the row Id of a restriction (From DescribeRestrictions' output, for example. +Removes that restriction from the session's limits. + +=cut + +sub DeleteRestriction { + my $self = shift; + my $row = shift; + delete $self->{'TicketRestrictions'}{$row}; + + $self->{'RecalcTicketLimits'} = 1; + + #make the underlying easysearch object forget all its preconceptions +} + + + +# Convert a set of oldstyle SB Restrictions to Clauses for RQL + +sub _RestrictionsToClauses { + my $self = shift; + + my %clause; + foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) { + my $restriction = $self->{'TicketRestrictions'}{$row}; + + # We need to reimplement the subclause aggregation that SearchBuilder does. + # Default Subclause is ALIAS.FIELD, and default ALIAS is 'main', + # Then SB AND's the different Subclauses together. + + # So, we want to group things into Subclauses, convert them to + # SQL, and then join them with the appropriate DefaultEA. + # Then join each subclause group with AND. + + my $field = $restriction->{'FIELD'}; + my $realfield = $field; # CustomFields fake up a fieldname, so + # we need to figure that out + + # One special case + # Rewrite LinkedTo meta field to the real field + if ( $field =~ /LinkedTo/ ) { + $realfield = $field = $restriction->{'TYPE'}; + } + + # Two special case + # Handle subkey fields with a different real field + if ( $field =~ /^(\w+)\./ ) { + $realfield = $1; + } + + die "I don't know about $field yet" + unless ( exists $FIELD_METADATA{$realfield} + or $restriction->{CUSTOMFIELD} ); + + my $type = $FIELD_METADATA{$realfield}->[0]; + my $op = $restriction->{'OPERATOR'}; + + my $value = ( + grep {defined} + map { $restriction->{$_} } qw(VALUE TICKET BASE TARGET) + )[0]; + + # this performs the moral equivalent of defined or/dor/C<//>, + # without the short circuiting.You need to use a 'defined or' + # type thing instead of just checking for truth values, because + # VALUE could be 0.(i.e. "false") + + # You could also use this, but I find it less aesthetic: + # (although it does short circuit) + #( defined $restriction->{'VALUE'}? $restriction->{VALUE} : + # defined $restriction->{'TICKET'} ? + # $restriction->{TICKET} : + # defined $restriction->{'BASE'} ? + # $restriction->{BASE} : + # defined $restriction->{'TARGET'} ? + # $restriction->{TARGET} ) + + my $ea = $restriction->{ENTRYAGGREGATOR} + || $DefaultEA{$type} + || "AND"; + if ( ref $ea ) { + die "Invalid operator $op for $field ($type)" + unless exists $ea->{$op}; + $ea = $ea->{$op}; + } + + # Each CustomField should be put into a different Clause so they + # are ANDed together. + if ( $restriction->{CUSTOMFIELD} ) { + $realfield = $field; + } + + exists $clause{$realfield} or $clause{$realfield} = []; + + # Escape Quotes + $field =~ s!(['\\])!\\$1!g; + $value =~ s!(['\\])!\\$1!g; + my $data = [ $ea, $type, $field, $op, $value ]; + + # here is where we store extra data, say if it's a keyword or + # something. (I.e. "TYPE SPECIFIC STUFF") + + if (lc $ea eq 'none') { + $clause{$realfield} = [ $data ]; + } else { + push @{ $clause{$realfield} }, $data; + } + } + return \%clause; +} + + + +=head2 _ProcessRestrictions PARAMHASH + +# The new _ProcessRestrictions is somewhat dependent on the SQL stuff, +# but isn't quite generic enough to move into Tickets_SQL. + +=cut + +sub _ProcessRestrictions { + my $self = shift; + + #Blow away ticket aliases since we'll need to regenerate them for + #a new search + delete $self->{'TicketAliases'}; + delete $self->{'items_array'}; + delete $self->{'item_map'}; + delete $self->{'raw_rows'}; + delete $self->{'rows'}; + delete $self->{'count_all'}; + + my $sql = $self->Query; # Violating the _SQL namespace + if ( !$sql || $self->{'RecalcTicketLimits'} ) { + + # "Restrictions to Clauses Branch\n"; + my $clauseRef = eval { $self->_RestrictionsToClauses; }; + if ($@) { + $RT::Logger->error( "RestrictionsToClauses: " . $@ ); + $self->FromSQL(""); + } + else { + $sql = $self->ClausesToSQL($clauseRef); + $self->FromSQL($sql) if $sql; + } + } + + $self->{'RecalcTicketLimits'} = 0; + +} + +=head2 _BuildItemMap + +Build up a L</ItemMap> of first/last/next/prev items, so that we can +display search nav quickly. + +=cut + +sub _BuildItemMap { + my $self = shift; + + my $window = RT->Config->Get('TicketsItemMapSize'); + + $self->{'item_map'} = {}; + + my $items = $self->ItemsArrayRefWindow( $window ); + return unless $items && @$items; + + my $prev = 0; + $self->{'item_map'}{'first'} = $items->[0]->EffectiveId; + for ( my $i = 0; $i < @$items; $i++ ) { + my $item = $items->[$i]; + my $id = $item->EffectiveId; + $self->{'item_map'}{$id}{'defined'} = 1; + $self->{'item_map'}{$id}{'prev'} = $prev; + $self->{'item_map'}{$id}{'next'} = $items->[$i+1]->EffectiveId + if $items->[$i+1]; + $prev = $id; + } + $self->{'item_map'}{'last'} = $prev + if !$window || @$items < $window; +} + +=head2 ItemMap + +Returns an a map of all items found by this search. The map is a hash +of the form: + + { + first => <first ticket id found>, + last => <last ticket id found or undef>, + + <ticket id> => { + prev => <the ticket id found before>, + next => <the ticket id found after>, + }, + <ticket id> => { + prev => ..., + next => ..., + }, + } + +=cut + +sub ItemMap { + my $self = shift; + $self->_BuildItemMap unless $self->{'item_map'}; + return $self->{'item_map'}; +} + + + + +=head2 PrepForSerialization + +You don't want to serialize a big tickets object, as +the {items} hash will be instantly invalid _and_ eat +lots of space + +=cut + +sub PrepForSerialization { + my $self = shift; + delete $self->{'items'}; + delete $self->{'items_array'}; + $self->RedoSearch(); +} + +=head1 FLAGS + +RT::Tickets supports several flags which alter search behavior: + + +allow_deleted_search (Otherwise never show deleted tickets in search results) +looking_at_type (otherwise limit to type=ticket) + +These flags are set by calling + +$tickets->{'flagname'} = 1; + +BUG: There should be an API for this + + + +=cut + + + +=head2 NewItem + +Returns an empty new RT::Ticket item + +=cut + +sub NewItem { + my $self = shift; + return(RT::Ticket->new($self->CurrentUser)); +} +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/User.pm b/rt/lib/RT/User.pm index af4a6ad99..0094f9807 100755 --- a/rt/lib/RT/User.pm +++ b/rt/lib/RT/User.pm @@ -81,7 +81,6 @@ use Digest::MD5; use RT::Principals; use RT::ACE; use RT::Interface::Email; -use Encode; use Text::Password::Pronounceable; sub _OverlayAccessible { @@ -102,7 +101,6 @@ sub _OverlayAccessible { AuthSystem => { public => 1, admin => 1 }, Gecos => { public => 1, admin => 1 }, PGPKey => { public => 1, admin => 1 }, - PrivateKey => { admin => 1 }, } } @@ -880,7 +878,7 @@ sub _GeneratePassword_sha512 { my $sha = Digest::SHA->new(512); $sha->add($salt); - $sha->add(encode_utf8($password)); + $sha->add(Encode::encode( 'UTF-8', $password)); return join("!", "", "sha512", $salt, $sha->b64digest); } @@ -957,16 +955,16 @@ sub IsPassword { my $hash = MIME::Base64::decode_base64($stored); # Decoding yields 30 byes; first 4 are the salt, the rest are substr(SHA256,0,26) my $salt = substr($hash, 0, 4, ""); - return 0 unless substr(Digest::SHA::sha256($salt . Digest::MD5::md5(encode_utf8($value))), 0, 26) eq $hash; + return 0 unless substr(Digest::SHA::sha256($salt . Digest::MD5::md5(Encode::encode( "UTF-8", $value))), 0, 26) eq $hash; } elsif (length $stored == 32) { # Hex nonsalted-md5 - return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored; + return 0 unless Digest::MD5::md5_hex(Encode::encode( "UTF-8", $value)) eq $stored; } elsif (length $stored == 22) { # Base64 nonsalted-md5 - return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored; + return 0 unless Digest::MD5::md5_base64(Encode::encode( "UTF-8", $value)) eq $stored; } elsif (length $stored == 13) { # crypt() output - return 0 unless crypt(encode_utf8($value), $stored) eq $stored; + return 0 unless crypt(Encode::encode( "UTF-8", $value), $stored) eq $stored; } else { $RT::Logger->warning("Unknown password form"); return 0; @@ -1055,8 +1053,7 @@ sub GenerateAuthString { my $self = shift; my $protect = shift; - my $str = $self->AuthToken . $protect; - utf8::encode($str); + my $str = Encode::encode( "UTF-8", $self->AuthToken . $protect ); return substr(Digest::MD5::md5_hex($str),0,16); } @@ -1073,8 +1070,7 @@ sub ValidateAuthString { my $auth_string = shift; my $protected = shift; - my $str = $self->AuthToken . $protected; - utf8::encode( $str ); + my $str = Encode::encode( "UTF-8", $self->AuthToken . $protected ); return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16); } @@ -1346,10 +1342,8 @@ sub Preferences { my $name = _PrefName (shift); my $default = shift; - my $attr = RT::Attribute->new( $self->CurrentUser ); - $attr->LoadByNameAndObject( Object => $self, Name => $name ); - - my $content = $attr->Id ? $attr->Content : undef; + my ($attr) = $self->Attributes->Named( $name ); + my $content = $attr ? $attr->Content : undef; unless ( ref $content eq 'HASH' ) { return defined $content ? $content : $default; } @@ -1378,9 +1372,8 @@ sub SetPreferences { return (0, $self->loc("No permission to set preferences")) unless $self->CurrentUserCanModify('Preferences'); - my $attr = RT::Attribute->new( $self->CurrentUser ); - $attr->LoadByNameAndObject( Object => $self, Name => $name ); - if ( $attr->Id ) { + my ($attr) = $self->Attributes->Named( $name ); + if ( $attr ) { my ($ok, $msg) = $attr->SetContent( $value ); return (1, "No updates made") if $msg eq "That is already the current value"; @@ -1403,13 +1396,11 @@ sub DeletePreferences { return (0, $self->loc("No permission to set preferences")) unless $self->CurrentUserCanModify('Preferences'); - my $attr = RT::Attribute->new( $self->CurrentUser ); - $attr->LoadByNameAndObject( Object => $self, Name => $name ); - if ( $attr->Id ) { - return $attr->Delete; - } + my ($attr) = $self->DeleteAttribute( $name ); + return (0, $self->loc("Preferences were not found")) + unless $attr; - return (0, $self->loc("Preferences were not found")); + return 1; } =head2 Stylesheet @@ -1652,7 +1643,8 @@ sub SetPrivateKey { my $self = shift; my $key = shift; - unless ($self->CurrentUserCanModify('PrivateKey')) { + # Users should not be able to change their own PrivateKey values + unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) { return (0, $self->loc("Permission Denied")); } diff --git a/rt/lib/RT/Util.pm b/rt/lib/RT/Util.pm index 9720f1da8..f8ffccfb9 100644 --- a/rt/lib/RT/Util.pm +++ b/rt/lib/RT/Util.pm @@ -125,7 +125,7 @@ sub mime_recommended_filename { $head = $head->head if $head->isa('MIME::Entity'); for my $attr_name (qw( content-disposition.filename content-type.name )) { - my $value = $head->mime_attr($attr_name); + my $value = Encode::decode("UTF-8",$head->mime_attr($attr_name)); if ( defined $value && $value =~ /\S/ ) { return $value; } @@ -133,6 +133,23 @@ sub mime_recommended_filename { return; } +sub assert_bytes { + my $string = shift; + return unless utf8::is_utf8($string); + return unless $string =~ /([^\x00-\x7F])/; + + my $msg; + if (ord($1) > 255) { + $msg = "Expecting a byte string, but was passed characters"; + } else { + $msg = "Expecting a byte string, but was possibly passed charcters;" + ." if the string is actually bytes, please use utf8::downgrade"; + } + $RT::Logger->warn($msg, Carp::longmess()); + +} + + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RTx/.Calendar.pm.swp b/rt/lib/RTx/.Calendar.pm.swp Binary files differnew file mode 100644 index 000000000..444c2f509 --- /dev/null +++ b/rt/lib/RTx/.Calendar.pm.swp diff --git a/rt/lib/RTx/.Schedule.pm.swp b/rt/lib/RTx/.Schedule.pm.swp Binary files differnew file mode 100644 index 000000000..5fb7a01c3 --- /dev/null +++ b/rt/lib/RTx/.Schedule.pm.swp diff --git a/rt/sbin/rt-attributes-viewer b/rt/sbin/rt-attributes-viewer new file mode 100755 index 000000000..35449e0ec --- /dev/null +++ b/rt/sbin/rt-attributes-viewer @@ -0,0 +1,122 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +use Getopt::Long; +my %opt; +GetOptions( \%opt, 'help|h', ); + +my $id = shift; + +if ( $opt{help} || !$id ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; +} + +require RT; +RT::LoadConfig(); +RT::Init(); + +require RT::Attribute; +my $attr = RT::Attribute->new( RT->SystemUser ); +$attr->Load( $id ); +unless ( $attr->id ) { + print STDERR "Couldn't load attribute #$id\n"; + exit 1; +} + +my %res = (); +$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType); + +use Data::Dumper; +print "Content of attribute #$id: ". Dumper( \%res ); + +__END__ + +=head1 NAME + +rt-attributes-viewer - show the content of an attribute + +=head1 SYNOPSIS + + # show the content of attribute 2 + rt-attributes-viewer 2 + +=head1 DESCRIPTION + +This script deserializes and print content of an attribute defined +by <attribute id>. May be useful for developers and for troubleshooting +problems. + diff --git a/rt/sbin/rt-clean-sessions b/rt/sbin/rt-clean-sessions new file mode 100755 index 000000000..02e1901d0 --- /dev/null +++ b/rt/sbin/rt-clean-sessions @@ -0,0 +1,190 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +use Getopt::Long; +my %opt; +GetOptions( \%opt, "older=s", "debug", "help|h", "skip-user" ); + + +if ( $opt{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; +} + + +if( $opt{'older'} ) { + unless( $opt{'older'} =~ /^\s*([0-9]+)\s*(H|D|M|Y)?$/i ) { + print STDERR "wrong format of the 'older' argumnet\n"; + exit(1); + } + my ($num,$unit) = ($1, uc($2 ||'D')); + my %factor = ( H => 60*60 ); + $factor{'D'} = $factor{'H'}*24; + $factor{'M'} = $factor{'D'}*31; + $factor{'Y'} = $factor{'D'}*365; + $opt{'older'} = $num * $factor{ $unit }; +} + +require RT; +RT::LoadConfig(); + +if( $opt{'debug'} ) { + RT->Config->Set( LogToScreen => 'debug' ); +} else { + RT->Config->Set( LogToScreen => undef ); +} + +RT::ConnectToDatabase(); +RT::InitLogging(); + +require RT::Interface::Web::Session; + +my $alogoff = int RT->Config->Get('AutoLogoff'); +if ( $opt{'older'} or $alogoff ) { + my $min; + foreach ($alogoff*60, $opt{'older'}) { + next unless $_; + $min = $_ unless $min; + $min = $_ if $_ < $min; + } + + RT::Interface::Web::Session->ClearOld( $min ); +} + +RT::Interface::Web::Session->ClearByUser + unless $opt{'skip-user'}; + +exit(0); + +__END__ + +=head1 NAME + +rt-clean-sessions - clean old and duplicate RT sessions + +=head1 SYNOPSIS + + rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]] + + rt-clean-sessions + rt-clean-sessions --debug + rt-clean-sessions --older 10D + rt-clean-sessions --debug --older 1M + rt-clean-sessions --older 10D --skip-user + +=head1 DESCRIPTION + +Script cleans RT sessions from DB or dir with sessions data. +Leaves in DB only one session per RT user and sessions that aren't older +than specified(see options). + +Script is safe because data in the sessions is temporary and can be deleted. + +=head1 OPTIONS + +=over 4 + +=item older + +Date interval in the C<< <NUM>[<unit>] >> format. Default unit is D(ays), +H(our), M(onth) and Y(ear) are also supported. + +For example: C<rt-clean-sessions --older 1M> would delete all sessions that are +older than 1 month. + +=item skip-user + +By default only one session per user left in the DB, so users that have +sessions on multiple computers or in different browsers will be logged out. +Use this option to avoid this. + +=item debug + +Turn on debug output. + +=back + +=head1 NOTES + +Functionality similar to this is implemented in +html/Elements/SetupSessionCookie ; however, that does not guarantee +that a session will be removed from disk and database soon after the +timeout expires. This script, if run from a cron job, will ensure +that the timed out sessions are actually removed from disk; the Mason +component just ensures that the old sessions are not reusable before +the cron job gets to them. + +=cut diff --git a/rt/sbin/rt-dump-metadata b/rt/sbin/rt-dump-metadata new file mode 100755 index 000000000..a2ebe3622 --- /dev/null +++ b/rt/sbin/rt-dump-metadata @@ -0,0 +1,357 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure +# it is UTF-8 so further XMLin will not break +binmode( STDOUT, ":utf8" ); + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ( "/opt/rt3/lib", "/opt/rt3/local/lib" ); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long; +my %opt; +GetOptions( \%opt, "help|h", + "limit-to-privileged|l", + "skip-disabled|s", + "all|a", +); + +if ( $opt{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +require XML::Simple; + +RT::LoadConfig(); +RT::Init(); + +my %RV; +my %Ignore = ( + All => [ + qw( + id Created Creator LastUpdated LastUpdatedBy + ) + ], + Templates => [ + qw( + TranslationOf + ) + ], +); + +my $SystemUserId = RT->SystemUser->Id; +my @classes = qw( + Users Groups Queues ScripActions ScripConditions + Templates Scrips ACL CustomFields + ); +foreach my $class (@classes) { + require "RT/$class.pm"; + my $objects = "RT::$class"->new( RT->SystemUser ); + $objects->{find_disabled_rows} = 1 unless $opt{'skip-disabled'}; + $objects->UnLimit; + $objects->LimitToPrivileged if $class eq 'Users' + && $opt{'limit-to-privileged'}; + $objects->Limit( + FIELD => 'Domain', + OPERATOR => '=', + VALUE => 'UserDefined' + ) if $class eq 'Groups'; + + if ( $class eq 'CustomFields' ) { + $objects->OrderByCols( + { FIELD => 'LookupType' }, + { FIELD => 'SortOrder' }, + { FIELD => 'Id' }, + ); + } else { + $objects->OrderBy( FIELD => 'Id' ); + } + + unless ($opt{all}) { + next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX + $objects->Limit( + FIELD => 'LastUpdatedBy', + OPERATOR => '!=', + VALUE => $SystemUserId + ) unless $class eq 'Groups'; + $objects->Limit( + FIELD => 'Id', + OPERATOR => '!=', + VALUE => $SystemUserId + ) if $class eq 'Users'; + } + + my %fields; +OBJECT: + while ( my $obj = $objects->Next ) { + next + if $obj->can('LastUpdatedBy') + and $obj->LastUpdatedBy == $SystemUserId; + + if ( !%fields ) { + %fields = map { $_ => 1 } keys %{ $obj->_ClassAccessible }; + delete @fields{ @{ $Ignore{$class} ||= [] }, + @{ $Ignore{All} ||= [] }, }; + } + + my $rv; + + if ( $class ne 'ACL' ) { + # next if $obj-> # skip default names + foreach my $field ( sort keys %fields ) { + my $value = $obj->__Value($field); + $rv->{$field} = $value if ( defined($value) && length($value) ); + } + delete $rv->{Disabled} unless $rv->{Disabled}; + + foreach my $record ( map { /ACL/ ? 'ACE' : substr( $_, 0, -1 ) } + @classes ) + { + foreach my $key ( map "$record$_", ( '', 'Id' ) ) { + next unless exists $rv->{$key}; + my $id = $rv->{$key} or next; + my $obj = "RT::$record"->new( RT->SystemUser ); + $obj->LoadByCols( Id => $id ) or next; + $rv->{$key} = $obj->__Value('Name') || 0; + } + } + + if ( $class eq 'Users' and defined $obj->Privileged ) { + $rv->{Privileged} = int( $obj->Privileged ); + } elsif ( $class eq 'CustomFields' ) { + my $values = $obj->Values; + while ( my $value = $values->Next ) { + push @{ $rv->{Values} }, { + map { ( $_ => $value->__Value($_) ) } + qw( + Name Description SortOrder + ), + }; + } + if ( $obj->LookupType eq 'RT::Queue-RT::Ticket' ) { + # XXX-TODO: unused CF's turn into global CF when importing + # as the sub InsertData in RT::Handle creates a global CF + # when no queue is specified. + $rv->{Queue} = []; + my $applies = $obj->AppliedTo; + while ( my $queue = $applies->Next ) { + push @{ $rv->{Queue} }, $queue->Name; + } + } + } + } + else { + # 1) pick the right + $rv->{Right} = $obj->RightName; + + # 2) Pick a level: Granted on Queue, CF, CF+Queue, or Globally? + for ( $obj->ObjectType ) { + if ( /^RT::Queue$/ ) { + next OBJECT if $opt{'skip-disabled'} && $obj->Object->Disabled; + $rv->{Queue} = $obj->Object->Name; + } + elsif ( /^RT::CustomField$/ ) { + next OBJECT if $opt{'skip-disabled'} && $obj->Object->Disabled; + $rv->{CF} = $obj->Object->Name; + } + elsif ( /^RT::Group$/ ) { + # No support for RT::Group ACLs in RT::Handle yet. + next OBJECT; + } + elsif ( /^RT::System$/ ) { + # skip setting anything on $rv; + # "Specifying none of the above will get you a global right." + } + } + + # 3) Pick a Principal; User or Group or Role + if ( $obj->PrincipalType eq 'Group' ) { + next OBJECT if $opt{'skip-disabled'} && $obj->PrincipalObj->Disabled; + my $group = $obj->PrincipalObj->Object; + for ( $group->Domain ) { + # An internal user group + if ( /^SystemInternal$/ ) { + $rv->{GroupDomain} = $group->Domain; + $rv->{GroupType} = $group->Type; + } + # An individual user + elsif ( /^ACLEquivalence$/ ) { + my $member = $group->MembersObj->Next->MemberObj; + next OBJECT if $opt{'skip-disabled'} && $member->Disabled; + $rv->{UserId} = $member->Object->Name; + } + # A group you created + elsif ( /^UserDefined$/ ) { + $rv->{GroupDomain} = 'UserDefined'; + $rv->{GroupId} = $group->Name; + } + } + } else { + $rv->{GroupType} = $obj->PrincipalType; + # A system-level role + if ( $obj->ObjectType eq 'RT::System' ) { + $rv->{GroupDomain} = 'RT::System-Role'; + } + # A queue-level role + elsif ( $obj->ObjectType eq 'RT::Queue' ) { + $rv->{GroupDomain} = 'RT::Queue-Role'; + } + } + if ( $obj->LookupType eq 'RT::Queue-RT::Ticket' ) { + # XXX-TODO: unused CF's turn into global CF when importing + # as the sub InsertData in RT::Handle creates a global CF + # when no queue is specified. + $rv->{Queue} = []; + my $applies = $obj->AppliedTo; + while ( my $queue = $applies->Next ) { + push @{ $rv->{Queue} }, $queue->Name; + } + } + } + + if ( eval { require RT::Attributes; 1 } ) { + my $attributes = $obj->Attributes; + while ( my $attribute = $attributes->Next ) { + my $content = $attribute->Content; + if ( $class eq 'Users' and $attribute->Name eq 'Bookmarks' ) { + next; + } + $rv->{Attributes}{ $attribute->Name } = $content + if length($content); + } + } + + push @{ $RV{$class} }, $rv; + } +} + +print(<< "."); +no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw( + @classes Values +)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml +__DATA__ +. + +print XML::Simple::XMLout( + { map { ( $_ => ( $RV{$_} || [] ) ) } @classes }, + RootName => 'InitialData', + NoAttr => 1, + SuppressEmpty => '', + XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>', +); + +__END__ + +=head1 NAME + +rt-dump-metadata - dump configuration metadata from an RT database + +=head1 SYNOPSIS + + rt-dump-metdata [--all] + +=head1 DESCRIPTION + +C<rt-dump-metadata> is a tool that dumps configuration metadata from the +Request Tracker database into XML format, suitable for feeding into +C<rt-setup-database>. To dump and load a full RT database, you should generally +use the native database tools instead, as well as performing any necessary +steps from UPGRADING. + +This is NOT a tool for backing up an RT database. See also +L<docs/initialdata> for more straightforward means of importing data. + +=head1 OPTIONS + +=over + +=item C<--all> or C<-a> + +When run with C<--all>, the dump will include all configuration +metadata; otherwise, the metadata dump will only include 'local' +configuration changes, i.e. those done manually in the web interface. + +=item C<--limit-to-privileged> or C<-l> + +Causes the dumper to only dump privileged users. + +=item C<--skip-disabled> or C<-s> + +Ignores disabled rows in the database. + +=back + +=cut + diff --git a/rt/sbin/rt-email-dashboards b/rt/sbin/rt-email-dashboards new file mode 100755 index 000000000..7c797ab25 --- /dev/null +++ b/rt/sbin/rt-email-dashboards @@ -0,0 +1,173 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +# Read in the options +my %opts; +use Getopt::Long; +GetOptions( \%opts, + "help|h", "dryrun", "time=i", "epoch=i", "all" +); + +if ($opts{'help'}) { + require Pod::Usage; + print Pod::Usage::pod2usage(-verbose => 2); + exit; +} + +require RT; +require RT::Interface::CLI; +RT::Interface::CLI->import(qw{ CleanEnv loc }); + +# Clean out all the nasties from the environment +CleanEnv(); + +# Load the config file +RT::LoadConfig(); + +# Connect to the database and get RT::SystemUser and RT::Nobody loaded +RT::Init(); + +require RT::Dashboard::Mailer; +RT::Dashboard::Mailer->MailDashboards( + All => $opts{all}, + DryRun => $opts{dryrun}, + Time => ($opts{time} || $opts{epoch} || time), # epoch is the old-style + Opts => \%opts, +); + +=head1 NAME + +rt-email-dashboards - Send email dashboards + +=head1 SYNOPSIS + + rt-email-dashboards [options] + +=head1 DESCRIPTION + +This tool will send users email based on how they have subscribed to +dashboards. A dashboard is a set of saved searches, the subscription controls +how often that dashboard is sent and how it's displayed. + +Each subscription has an hour, and possibly day of week or day of month. These +are taken to be in the user's timezone if available, UTC otherwise. + +=head1 SETUP + +You'll need to have cron run this script every hour. Here's an example crontab +entry to do this. + + 0 * * * * /usr/bin/perl /opt/rt4/local/sbin/rt-email-dashboards + +This will run the script every hour on the hour. This may need some further +tweaking to be run as the correct user. + +=head1 OPTIONS + +This tool supports a few options. Most are for debugging. + +=over 8 + +=item -h + +=item --help + +Display this documentation + +=item --dryrun + +Figure out which dashboards would be sent, but don't actually generate or email +any of them + +=item --time SECONDS + +Instead of using the current time to figure out which dashboards should be +sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would +be Oct 12 19:06:58 GMT 2007). + +=item --epoch SECONDS + +Back-compat for --time SECONDS. + +=item --all + +Ignore subscription frequency when considering each dashboard (should only be +used with --dryrun for testing and debugging) + +=back + +=cut + diff --git a/rt/sbin/rt-email-digest b/rt/sbin/rt-email-digest new file mode 100755 index 000000000..6efab1190 --- /dev/null +++ b/rt/sbin/rt-email-digest @@ -0,0 +1,380 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 warnings; +use strict; + +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Date::Format qw( strftime ); +use Getopt::Long; +use RT; +use RT::Interface::CLI qw( CleanEnv loc ); +use RT::Interface::Email; + +CleanEnv(); +RT::LoadConfig(); +RT::Init(); + +sub usage { + my ($error) = @_; + print loc("Usage:") . " $0 -m (daily|weekly) [--print] [--help]\n"; + print loc( + "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.", + $0 + ) . "\n"; + print "\n\t-m, --mode\t" + . loc("Specify whether this is a daily or weekly run.") . "\n"; + print "\t-p, --print\t" + . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent") + . "\n"; + print "\t-v, --verbose\t" . loc("Give output even on messages successfully sent") . "\n"; + print "\t-h, --help\t" . loc("Print this message") . "\n"; + + if ( $error eq 'help' ) { + exit 0; + } else { + print loc("Error") . ": " . loc($error) . "\n"; + exit 1; + } +} + +my ( $frequency, $print, $verbose, $help ) = ( '', '', '', '' ); +GetOptions( + 'mode=s' => \$frequency, + 'print' => \$print, + 'verbose' => \$verbose, + 'help' => \$help, +); + +usage('help') if $help; +usage("Mode argument must be 'daily' or 'weekly'") + unless $frequency =~ /^(daily|weekly)$/; + +run( $frequency, $print ); + +sub run { + my $frequency = shift; + my $print = shift; + +## Find all the tickets that have been modified within the time frame +## described by $frequency. + + my ( $all_digest, $sent_transactions ) = find_transactions($frequency); + +## Iterate through our huge hash constructing the digest message +## for each user and sending it. + + foreach my $user ( keys %$all_digest ) { + my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} ); + # Now we have a content head and a content body. We can send a message. + if ( send_digest( $user, $contents_list, $contents_body ) ) { + print "Sent message to $user\n" if $verbose; + mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print); + } else { + print "Failed to send message to $user\n"; + } + } +} +exit 0; + +# Subroutines. + +sub send_digest { + my ( $to, $index, $messages ) = @_; + + # Combine the index and the messages. + + my $body = "============== Tickets with activity in the last " + . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n"; + + $body .= $index; + $body .= "\n\n============== Messages recorded in the last " + . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n"; + $body .= $messages; + + # Load our template. If we cannot load the template, abort + # immediately rather than failing through many loops. + my $digest_template = RT::Template->new( RT->SystemUser ); + my ( $ret, $msg ) = $digest_template->Load('Email Digest'); + unless ($ret) { + print loc("Failed to load template") + . " 'Email Digest': " + . $msg + . ". Cannot continue.\n"; + exit 1; + } + ( $ret, $msg ) = $digest_template->Parse( Argument => $body ); + unless ($ret) { + print loc("Failed to parse template") + . " 'Email Digest'. Cannot continue.\n"; + exit 1; + } + + # Set our sender and recipient. + $digest_template->MIMEObj->head->replace( + 'From', Encode::encode( "UTF-8", RT::Config->Get('CorrespondAddress') ) ); + $digest_template->MIMEObj->head->replace( + 'To', Encode::encode( "UTF-8", $to ) ); + + if ($print) { + $digest_template->MIMEObj->print; + return 1; + } else { + return RT::Interface::Email::SendEmail( Entity => $digest_template->MIMEObj) + } +} + +# =item mark_transactions_sent( $frequency, $user, @txn_list ); +# +# Takes a frequency string (either 'daily' or 'weekly'), a user and one or more +# transaction objects as its arguments. Marks the given deferred +# notifications as sent. +# +# =cut + +sub mark_transactions_sent { + my ( $freq, $user, @txns ) = @_; + return unless $freq =~ /(daily|weekly)/; + return unless @txns; + foreach my $txn (@txns) { + + # Grab the attribute, mark the "sent" as true, and store the new + # value. + if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) { + my $deferred = $attr->Content; + $deferred->{$freq}->{$user}->{'_sent'} = 1; + $txn->SetAttribute( + Name => 'DeferredRecipients', + Description => 'Deferred recipients for this message', + Content => $deferred, + ); + } + } +} + +sub since_date { + my $frequency = shift; + + # Specify a short time for digest overlap, in case we aren't starting + # this process exactly on time. + my $OVERLAP_HEDGE = -30; + + my $since_date = RT::Date->new( RT->SystemUser ); + $since_date->Set( Format => 'unix', Value => time() ); + if ( $frequency eq 'daily' ) { + $since_date->AddDays(-1); + } else { + $since_date->AddDays(-7); + } + + $since_date->AddSeconds($OVERLAP_HEDGE); + + return $since_date; +} + +sub find_transactions { + my $frequency = shift; + my $since_date = since_date($frequency); + + my $txns = RT::Transactions->new( RT->SystemUser ); + + # First limit to recent transactions. + $txns->Limit( + FIELD => 'Created', + OPERATOR => '>', + VALUE => $since_date->ISO + ); + + # Next limit to ticket transactions. + $txns->Limit( + FIELD => 'ObjectType', + OPERATOR => '=', + VALUE => 'RT::Ticket', + ENTRYAGGREGATOR => 'AND' + ); + my $all_digest = {}; + my $sent_transactions = {}; + + while ( my $txn = $txns->Next ) { + my $ticket = $txn->Ticket; + my $queue = $txn->TicketObj->QueueObj->Name; + # Xxx todo - may clobber if two queues have the same name + foreach my $user ( $txn->DeferredRecipients($frequency) ) { + $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj; + $sent_transactions->{$user}->{ $txn->id } = $txn; + } + } + + return ( $all_digest, $sent_transactions ); +} + +sub build_digest_for_user { + my $user = shift; + my $user_digest = shift; + + my $contents_list = ''; # Holds the digest index. + my $contents_body = ''; # Holds the digest body. + + # Has the user been disabled since a message was deferred on his/her + # behalf? + my $user_obj = RT::User->new( RT->SystemUser ); + $user_obj->LoadByEmail($user); + if ( $user_obj->PrincipalObj->Disabled ) { + print STDERR loc("Skipping disabled user") . " $user\n"; + next; + } + + print loc("Message for user") . " $user:\n\n" if $print; + foreach my $queue ( keys %$user_digest ) { + $contents_list .= "Queue $queue:\n"; + $contents_body .= "Queue $queue:\n"; + foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) { + my $tkt_txns = $user_digest->{$queue}->{$ticket}; + my $ticket_obj = RT::Ticket->new( RT->SystemUser ); + $ticket_obj->Load($ticket); + + # Spit out the index entry for this ticket. + my $ticket_title = sprintf( + "#%d %s [%s]\t%s\n", + $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name, + $ticket_obj->Subject + ); + $contents_list .= $ticket_title; + + # Spit out the messages for the transactions on this ticket. + $contents_body .= "\n== $ticket_title\n"; + foreach my $txn ( sort keys %$tkt_txns ) { + my $msg = $tkt_txns->{$txn}; + + # $msg contains an RT::Attachment with our outgoing + # message. Print a few headers for clarity's sake. + $contents_body .= "From: " . $msg->GetHeader('From') . "\n"; + my $date = $msg->GetHeader('Date '); + unless ($date) { + my $txn_obj = RT::Transaction->new( RT->SystemUser ); + $txn_obj->Load($txn); + my $date_obj = RT::Date->new( RT->SystemUser ); + $date_obj->Set( + Format => 'sql', + Value => $txn_obj->Created + ); + $date = strftime( '%a, %d %b %Y %H:%M:%S %z', + @{ [ localtime( $date_obj->Unix ) ] } ); + } + $contents_body .= "Date: $date\n\n"; + $contents_body .= $msg->Content . "\n"; + $contents_body .= "-------\n"; + } # foreach transaction + } # foreach ticket + } # foreach queue + + return ( $contents_list, $contents_body ); + +} + +__END__ + +=head1 NAME + +rt-email-digest - dispatch deferred notifications as a per-user digest + +=head1 SYNOPSIS + + rt-email-digest -m (daily|weekly) [--print] [--help] + +=head1 DESCRIPTION + +This script is a tool to dispatch all deferred RT notifications as a per-user +object. + +=head1 OPTIONS + +=over + +=item mode + +Specify whether this is a daily or weekly run. + +--mode is equal to -m + +=item print + +Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent + +--print is equal to -p + +=item help + +Print this message + +--help is equal to -h + +=back diff --git a/rt/sbin/rt-email-digest.in b/rt/sbin/rt-email-digest.in index a535e3649..47cd8eb45 100644 --- a/rt/sbin/rt-email-digest.in +++ b/rt/sbin/rt-email-digest.in @@ -179,8 +179,10 @@ sub send_digest { } # Set our sender and recipient. - $digest_template->MIMEObj->head->replace( 'From', RT::Config->Get('CorrespondAddress') ); - $digest_template->MIMEObj->head->replace( 'To', $to ); + $digest_template->MIMEObj->head->replace( + 'From', Encode::encode( "UTF-8", RT::Config->Get('CorrespondAddress') ) ); + $digest_template->MIMEObj->head->replace( + 'To', Encode::encode( "UTF-8", $to ) ); if ($print) { $digest_template->MIMEObj->print; diff --git a/rt/sbin/rt-email-group-admin b/rt/sbin/rt-email-group-admin new file mode 100755 index 000000000..bfbdccd27 --- /dev/null +++ b/rt/sbin/rt-email-group-admin @@ -0,0 +1,527 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} +=head1 NAME + +rt-email-group-admin - Command line tool for administrating NotifyGroup actions + +=head1 SYNOPSIS + + rt-email-group-admin --list + rt-email-group-admin --create 'Notify foo team' --group Foo + rt-email-group-admin --create 'Notify foo team as comment' --comment --group Foo + rt-email-group-admin --create 'Notify group Foo and Bar' --group Foo --group Bar + rt-email-group-admin --create 'Notify user foo@bar.com' --user foo@bar.com + rt-email-group-admin --create 'Notify VIPs' --user vip1@bar.com + rt-email-group-admin --add 'Notify VIPs' --user vip2@bar.com --group vip1 --user vip3@foo.com + rt-email-group-admin --rename 'Notify VIPs' --newname 'Inform VIPs' + rt-email-group-admin --switch 'Notify VIPs' + rt-email-group-admin --delete 'Notify user foo@bar.com' + +=head1 DESCRIPTION + +This script list, create, modify or delete scrip actions in the RT DB. Once +you've created an action you can use it in a scrip. + +For example you can create the following action using this script: + + rt-email-group-admin --create 'Notify developers' --group 'Development Team' + +Then you can add the followoing scrip to your Bugs queue: + + Condition: On Create + Action: Notify developers + Template: Transaction + Stage: TransactionCreate + +Your development team will be notified on every new ticket in the queue. + +=cut + +use warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long qw(GetOptions); +Getopt::Long::Configure( "pass_through" ); + +our $cmd = 'usage'; +our $opts = {}; + +sub parse_args { + my $tmp; + if ( GetOptions( 'list' => \$tmp ) && $tmp ) { + $cmd = 'list'; + } + elsif ( GetOptions( 'create=s' => \$tmp ) && $tmp ) { + $cmd = 'create'; + $opts->{'name'} = $tmp; + $opts->{'groups'} = []; + $opts->{'users'} = []; + GetOptions( 'comment' => \$opts->{'comment'} ); + GetOptions( 'group:s@' => $opts->{'groups'} ); + GetOptions( 'user:s@' => $opts->{'users'} ); + unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) { + usage(); + exit(-1); + } + } + elsif ( GetOptions( 'add=s' => \$tmp ) && $tmp ) { + $cmd = 'add'; + $opts->{'name'} = $tmp; + $opts->{'groups'} = []; + $opts->{'users'} = []; + GetOptions( 'group:s@' => $opts->{'groups'} ); + GetOptions( 'user:s@' => $opts->{'users'} ); + unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) { + usage(); + exit(-1); + } + } + elsif ( GetOptions( 'switch=s' => \$tmp ) && $tmp ) { + $cmd = 'switch'; + $opts->{'name'} = $tmp; + } + elsif ( GetOptions( 'rename=s' => \$tmp ) && $tmp ) { + $cmd = 'rename'; + $opts->{'name'} = $tmp; + GetOptions( 'newname=s' => \$opts->{'newname'} ); + unless ( $opts->{'newname'} ) { + usage(); + exit(-1); + } + } + elsif ( GetOptions( 'delete=s' => \$tmp ) && $tmp) { + $cmd = 'delete'; + $opts->{'name'} = $tmp; + } else { + $cmd = 'usage'; + } + + return; +} + +sub usage { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); +} + +my $help; +if ( GetOptions( 'help|h' => \$help ) && $help ) { + usage(); + exit; +} + +parse_args(); + +require RT; +RT->LoadConfig; +RT->Init; + +require RT::Principal; +require RT::User; +require RT::Group; +require RT::ScripActions; + + +{ + eval "main::$cmd()"; + if ( $@ ) { + print STDERR $@ ."\n"; + } +} + +exit(0); + +=head1 USAGE + +rt-email-group-admin --COMMAND ARGS + +=head1 COMMANDS + +=head2 list + +Lists actions and its descriptions. + +=cut + +sub list { + my $actions = _get_our_actions(); + while( my $a = $actions->Next ) { + _list( $a ); + } + return; +} + +sub _list { + my $action = shift; + + print "Name: ". $action->Name() ."\n"; + print "Module: ". $action->ExecModule() ."\n"; + + my @princ = argument_to_list( $action ); + + print "Members: \n"; + foreach( @princ ) { + my $obj = RT::Principal->new( RT->SystemUser ); + $obj->Load( $_ ); + next unless $obj->id; + + print "\t". $obj->PrincipalType; + print "\t=> ". $obj->Object->Name; + print "(Disabled!!!)" if $obj->Disabled; + print "\n"; + } + print "\n"; + return; +} + +=head2 create NAME [--comment] [--group GNAME] [--user NAME-OR-EMAIL] + +Creates new action with NAME and adds users and/or groups to its +recipient list. Would be notify as comment if --comment specified. The +user, if specified, will be autocreated if necessary. + +=cut + +sub create { + my $actions = RT::ScripActions->new( RT->SystemUser ); + $actions->Limit( + FIELD => 'Name', + VALUE => $opts->{'name'}, + ); + if ( $actions->Count ) { + print STDERR "ScripAction '". $opts->{'name'} ."' allready exists\n"; + exit(-1); + } + + my @groups = _check_groups( @{ $opts->{'groups'} } ); + my @users = _check_users( @{ $opts->{'users'} } ); + unless ( @users + @groups ) { + print STDERR "List of groups and users is empty\n"; + exit(-1); + } + + my $action = __create_empty( $opts->{'name'}, $opts->{'comment'} ); + + __add( $action, $_ ) foreach( @users ); + __add( $action, $_ ) foreach( @groups ); + + return; +} + +sub __create_empty { + my $name = shift; + my $as_comment = shift || 0; + require RT::ScripAction; + my $action = RT::ScripAction->new( RT->SystemUser ); + $action->Create( + Name => $name, + Description => "Created with rt-email-group-admin script", + ExecModule => $as_comment? 'NotifyGroupAsComment': 'NotifyGroup', + Argument => '', + ); + + return $action; +} + +sub _check_groups +{ + return map {$_->[1]} + grep { $_->[1] ? 1: do { print STDERR "Group '$_->[0]' skipped, doesn't exist\n"; 0; } } + map { [$_, __check_group($_)] } @_; +} + +sub __check_group +{ + my $instance = shift; + require RT::Group; + my $obj = RT::Group->new( RT->SystemUser ); + $obj->LoadUserDefinedGroup( $instance ); + return $obj->id ? $obj : undef; +} + +sub _check_users +{ + return map {$_->[1]} + grep { $_->[1] ? 1: do { print STDERR "User '$_->[0]' skipped, doesn't exist and couldn't autocreate\n"; 0; } } + map { [$_, __check_user($_)] } @_; +} + +sub __check_user +{ + my $instance = shift; + require RT::User; + my $obj = RT::User->new( RT->SystemUser ); + $obj->Load( $instance ); + $obj->LoadByEmail( $instance ) + if not $obj->id and $instance =~ /@/; + + unless ($obj->id) { + my ($ok, $msg) = $obj->Create( + Name => $instance, + EmailAddress => $instance, + Privileged => 0, + Comments => 'Autocreated when added to notify action via rt-email-group-admin', + ); + print STDERR "Autocreate of user '$instance' failed: $msg\n" + unless $ok; + } + + return $obj->id ? $obj : undef; +} + +=head2 add NAME [--group GNAME] [--user NAME-OR-EMAIL] + +Adds groups and/or users to recipients of the action NAME. The user, if +specified, will be autocreated if necessary. + +=cut + +sub add { + my $action = _get_action_by_name( $opts->{'name'} ); + unless ( $action ) { + print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; + exit(-1); + } + + my @groups = _check_groups( @{ $opts->{'groups'} } ); + my @users = _check_users( @{ $opts->{'users'} } ); + + unless ( @users + @groups ) { + print STDERR "List of groups and users is empty\n"; + exit(-1); + } + + __add( $action, $_ ) foreach @users; + __add( $action, $_ ) foreach @groups; + + return; +} + +sub __add +{ + my $action = shift; + my $obj = shift; + + my @cur = argument_to_list( $action ); + + my $id = $obj->id; + return if grep $_ == $id, @cur; + + push @cur, $id; + + return $action->__Set( Field => 'Argument', Value => join(',', @cur) ); +} + +=head2 delete NAME + +Deletes action NAME if scrips doesn't use it. + +=cut + +sub delete { + my $action = _get_action_by_name( $opts->{'name'} ); + unless ( $action ) { + print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; + exit(-1); + } + + require RT::Scrips; + my $scrips = RT::Scrips->new( RT->SystemUser ); + $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id ); + if ( $scrips->Count ) { + my @sid; + while( my $s = $scrips->Next ) { + push @sid, $s->id; + } + print STDERR "ScripAction '". $opts->{'name'} ."'" + . " is in use by Scrip(s) ". join( ", ", map "#$_", @sid ) + . "\n"; + exit(-1); + } + + return __delete( $action ); +} + +sub __delete { + require DBIx::SearchBuilder::Record; + return DBIx::SearchBuilder::Record::Delete( shift ); +} + +sub _get_action_by_name { + my $name = shift; + my $actions = _get_our_actions(); + $actions->Limit( + FIELD => 'Name', + VALUE => $name + ); + + if ( $actions->Count > 1 ) { + print STDERR "More then one ScripAction with name '$name'\n"; + } + + return $actions->First; +} + +=head2 switch NAME + +Switch action NAME from notify as correspondence to comment and back. + +=cut + +sub switch { + my $action = _get_action_by_name( $opts->{'name'} ); + unless ( $action ) { + print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; + exit(-1); + } + + my %h = ( + NotifyGroup => 'NotifyGroupAsComment', + NotifyGroupAsComment => 'NotifyGroup' + ); + + return $action->__Set( + Field => 'ExecModule', + Value => $h{ $action->ExecModule } + ); +} + +=head2 rename NAME --newname NEWNAME + +Renames action NAME to NEWNAME. + +=cut + +sub rename { + my $action = _get_action_by_name( $opts->{'name'} ); + unless ( $action ) { + print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; + exit(-1); + } + + my $actions = RT::ScripActions->new( RT->SystemUser ); + $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} ); + if ( $actions->Count ) { + print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n"; + exit(-1); + } + + return $action->__Set( + Field => 'Name', + Value => $opts->{'newname'}, + ); +} + +=head2 NOTES + +If command has option --group or --user then you can use it more then once, +if other is not specified. + +=cut + +############### +#### Utils #### +############### + +sub argument_to_list { + my $action = shift; + require RT::Action::NotifyGroup; + return RT::Action::NotifyGroup->__SplitArg( $action->Argument ); +} + +sub _get_our_actions { + my $actions = RT::ScripActions->new( RT->SystemUser ); + $actions->Limit( + FIELD => 'ExecModule', + VALUE => 'NotifyGroup', + ENTRYAGGREGATOR => 'OR', + ); + $actions->Limit( + FIELD => 'ExecModule', + VALUE => 'NotifyGroupAsComment', + ENTRYAGGREGATOR => 'OR', + ); + + return $actions; +} + +=head1 AUTHOR + +Ruslan U. Zakirov E<lt>ruz@bestpractical.comE<gt> + +=head1 SEE ALSO + +L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment> + +=cut diff --git a/rt/sbin/rt-fulltext-indexer b/rt/sbin/rt-fulltext-indexer new file mode 100755 index 000000000..cdcc78e15 --- /dev/null +++ b/rt/sbin/rt-fulltext-indexer @@ -0,0 +1,479 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; +no warnings 'once'; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +BEGIN { + use RT; + RT::LoadConfig(); + RT::Init(); +}; +use RT::Interface::CLI (); + +my %OPT = ( + help => 0, + debug => 0, + quiet => 0, +); +my @OPT_LIST = qw(help|h! debug! quiet); + +my $db_type = RT->Config->Get('DatabaseType'); +if ( $db_type eq 'Pg' ) { + %OPT = ( + %OPT, + limit => 0, + all => 0, + ); + push @OPT_LIST, 'limit=i', 'all!'; +} +elsif ( $db_type eq 'mysql' ) { + %OPT = ( + %OPT, + limit => 0, + all => 0, + xmlpipe2 => 0, + ); + push @OPT_LIST, 'limit=i', 'all!', 'xmlpipe2!'; +} +elsif ( $db_type eq 'Oracle' ) { + %OPT = ( + %OPT, + memory => '2M', + ); + push @OPT_LIST, qw(memory=s); +} + +use Getopt::Long qw(GetOptions); +GetOptions( \%OPT, @OPT_LIST ); + +if ( $OPT{'help'} ) { + RT::Interface::CLI->ShowHelp( + Sections => 'NAME|DESCRIPTION|'. uc($db_type), + ); +} + +use Fcntl ':flock'; +if ( !flock main::DATA, LOCK_EX | LOCK_NB ) { + if ( $OPT{quiet} ) { + RT::Logger->info("$0 is already running; aborting silently, as requested"); + exit; + } + else { + print STDERR "$0 is already running\n"; + exit 1; + } +} + +my $fts_config = RT->Config->Get('FullTextSearch') || {}; +unless ( $fts_config->{'Enable'} ) { + print STDERR <<EOT; + +Full text search is disabled in your RT configuration. Run +/opt/rt3/sbin/rt-setup-fulltext-index to configure and enable it. + +EOT + exit 1; +} +unless ( $fts_config->{'Indexed'} ) { + print STDERR <<EOT; + +Full text search is enabled in your RT configuration, but not with any +full-text database indexing -- hence this tool is not required. Read +the documentation for %FullTextSearch in your RT_Config for more details. + +EOT + exit 1; +} + +if ( $db_type eq 'Oracle' ) { + my $index = $fts_config->{'IndexName'} || 'rt_fts_index'; + $RT::Handle->dbh->do( + "begin ctx_ddl.sync_index(?, ?); end;", undef, + $index, $OPT{'memory'} + ); + exit; +} elsif ( $db_type eq 'mysql' ) { + unless ($OPT{'xmlpipe2'}) { + print STDERR <<EOT; + +Updates to the external Sphinx index are done via running the sphinx +`indexer` tool: + + indexer rt + +EOT + exit 1; + } +} + +my @types = qw(text html); +foreach my $type ( @types ) { + REDO: + my $attachments = attachments($type); + $attachments->Limit( + FIELD => 'id', + OPERATOR => '>', + VALUE => last_indexed($type) + ); + $attachments->OrderBy( FIELD => 'id', ORDER => 'asc' ); + $attachments->RowsPerPage( $OPT{'limit'} || 100 ); + + my $found = 0; + while ( my $a = $attachments->Next ) { + next if filter( $type, $a ); + debug("Found attachment #". $a->id ); + my $txt = extract($type, $a) or next; + $found++; + process( $type, $a, $txt ); + debug("Processed attachment #". $a->id ); + } + finalize( $type, $attachments ) if $found; + clean( $type ); + goto REDO if $OPT{'all'} and $attachments->Count == ($OPT{'limit'} || 100) +} + +sub attachments { + my $type = shift; + my $res = RT::Attachments->new( RT->SystemUser ); + my $txn_alias = $res->Join( + ALIAS1 => 'main', + FIELD1 => 'TransactionId', + TABLE2 => 'Transactions', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $txn_alias, + FIELD => 'ObjectType', + VALUE => 'RT::Ticket', + ); + my $ticket_alias = $res->Join( + ALIAS1 => $txn_alias, + FIELD1 => 'ObjectId', + TABLE2 => 'Tickets', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $ticket_alias, + FIELD => 'Status', + OPERATOR => '!=', + 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", + arguments => [$res], + ); +} + +sub last_indexed { + my ($type) = (@_); + return goto_specific( + suffix => $db_type, + error => "Don't know how to find last indexed $type attachment for $db_type DB", + arguments => \@_, + ); +} + +sub filter { + my $type = shift; + return goto_specific( + suffix => $type, + arguments => \@_, + ); +} + +sub extract { + my $type = shift; + return goto_specific( + suffix => $type, + error => "No way to convert $type attachment into text", + arguments => \@_, + ); +} + +sub process { + return goto_specific( + suffix => $db_type, + error => "No processer for $db_type DB", + arguments => \@_, + ); +} + +sub finalize { + return goto_specific( + suffix => $db_type, + arguments => \@_, + ); +} + +sub clean { + return goto_specific( + suffix => $db_type, + arguments => \@_, + ); +} + +{ +sub last_indexed_mysql { + my $type = shift; + my $attr = $RT::System->FirstAttribute('LastIndexedAttachments'); + return 0 unless $attr; + return 0 unless exists $attr->{ $type }; + return $attr->{ $type } || 0; +} + +sub process_mysql { + my ($type, $attachment, $text) = (@_); + + my $doc = sphinx_template(); + + my $element = $doc->createElement('sphinx:document'); + $element->setAttribute( id => $attachment->id ); + $element->appendTextChild( content => $$text ); + + $doc->documentElement->appendChild( $element ); +} + +my $doc = undef; +sub sphinx_template { + return $doc if $doc; + + require XML::LibXML; + $doc = XML::LibXML::Document->new('1.0', 'UTF-8'); + my $root = $doc->createElement('sphinx:docset'); + $doc->setDocumentElement( $root ); + + my $schema = $doc->createElement('sphinx:schema'); + $root->appendChild( $schema ); + foreach ( qw(content) ) { + my $field = $doc->createElement('sphinx:field'); + $field->setAttribute( name => $_ ); + $schema->appendChild( $field ); + } + + return $doc; +} + +sub finalize_mysql { + my ($type, $attachments) = @_; + sphinx_template()->toFH(*STDOUT, 1); +} + +sub clean_mysql { + $doc = undef; +} + +} + +sub last_indexed_pg { + my $type = shift; + my $attachments = attachments( $type ); + my $alias = 'main'; + if ( $fts_config->{'Table'} && $fts_config->{'Table'} ne 'Attachments' ) { + $alias = $attachments->Join( + TYPE => 'left', + FIELD1 => 'id', + TABLE2 => $fts_config->{'Table'}, + FIELD2 => 'id', + ); + } + $attachments->Limit( + ALIAS => $alias, + FIELD => $fts_config->{'Column'}, + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + $attachments->OrderBy( FIELD => 'id', ORDER => 'desc' ); + $attachments->RowsPerPage( 1 ); + my $res = $attachments->First; + return 0 unless $res; + return $res->id; +} + +sub process_pg { + my ($type, $attachment, $text) = (@_); + + my $dbh = $RT::Handle->dbh; + my $table = $fts_config->{'Table'}; + my $column = $fts_config->{'Column'}; + + my $query; + if ( $table ) { + if ( my ($id) = $dbh->selectrow_array("SELECT id FROM $table WHERE id = ?", undef, $attachment->id) ) { + $query = "UPDATE $table SET $column = to_tsvector(?) WHERE id = ?"; + } else { + $query = "INSERT INTO $table($column, id) VALUES(to_tsvector(?), ?)"; + } + } else { + $query = "UPDATE Attachments SET $column = to_tsvector(?) WHERE id = ?"; + } + + my $status = eval { $dbh->do( $query, undef, $$text, $attachment->id ) }; + unless ( $status ) { + if ( $dbh->err == 7 && $dbh->state eq '54000' ) { + warn "Attachment @{[$attachment->id]} cannot be indexed. Most probably it contains too many unique words. Error: ". $dbh->errstr; + } elsif ( $dbh->err == 7 && $dbh->state eq '22021' ) { + warn "Attachment @{[$attachment->id]} cannot be indexed. Most probably it contains invalid UTF8 bytes. Error: ". $dbh->errstr; + } else { + die "error: ". $dbh->errstr; + } + + # Insert an empty tsvector, so we count this row as "indexed" + # for purposes of knowing where to pick up + eval { $dbh->do( $query, undef, "", $attachment->id ) } + or die "Failed to insert empty tsvector: " . $dbh->errstr; + } +} + +sub attachments_text { + my $res = shift; + $res->Limit( FIELD => 'ContentType', VALUE => 'text/plain' ); + return $res; +} + +sub extract_text { + my $attachment = shift; + my $text = $attachment->Content; + return undef unless defined $text && length($text); + return \$text; +} + +sub attachments_html { + my $res = shift; + $res->Limit( FIELD => 'ContentType', VALUE => 'text/html' ); + return $res; +} + +sub filter_html { + my $attachment = shift; + if ( my $parent = $attachment->ParentObj ) { +# skip html parts that are alternatives + return 1 if $parent->id + && $parent->ContentType eq 'mulitpart/alternative'; + } + return 0; +} + +sub extract_html { + my $attachment = shift; + my $text = $attachment->Content; + return undef unless defined $text && length($text); +# TODO: html -> text + return \$text; +} + +sub goto_specific { + my %args = (@_); + + my $func = (caller(1))[3]; + $func =~ s/.*:://; + my $call = $func ."_". lc $args{'suffix'}; + unless ( defined &$call ) { + return undef unless $args{'error'}; + require Carp; Carp::croak( $args{'error'} ); + } + @_ = @{ $args{'arguments'} }; + goto &$call; +} + + +# helper functions +sub debug { print @_, "\n" if $OPT{debug}; 1 } +sub error { $RT::Logger->error(_(@_)); 1 } +sub warning { $RT::Logger->warn(_(@_)); 1 } + +=head1 NAME + +rt-fulltext-indexer - Indexer for full text search + +=head1 DESCRIPTION + +This is a helper script to keep full text indexes in sync with data. +Read F<docs/full_text_indexing.pod> for complete details on how and when +to run it. + +=head1 AUTHOR + +Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>, +Alex Vandiver E<lt>alexmv@bestpractical.comE<gt> + +=cut + +__DATA__ diff --git a/rt/sbin/rt-preferences-viewer b/rt/sbin/rt-preferences-viewer new file mode 100755 index 000000000..e9d6ce337 --- /dev/null +++ b/rt/sbin/rt-preferences-viewer @@ -0,0 +1,149 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +use Getopt::Long; +my %opt; +GetOptions( \%opt, 'help|h', 'user|u=s', 'option|o=s' ); + +if ( $opt{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; +} + +require RT; +RT::LoadConfig(); +RT::Init(); + +require RT::Attributes; +my $attrs = RT::Attributes->new( RT->SystemUser ); +$attrs->Limit( FIELD => 'Name', VALUE => 'Pref-RT::System-1' ); +$attrs->Limit( FIELD => 'ObjectType', VALUE => 'RT::User' ); + +if ($opt{user}) { + my $user = RT::User->new( RT->SystemUser ); + my ($val, $msg) = $user->Load($opt{user}); + unless ($val) { + RT->Logger->error("Unable to load $opt{user}: $msg"); + exit(1); + } + $attrs->Limit( FIELD => 'ObjectId', VALUE => $user->Id ); +} + +use Data::Dumper; +$Data::Dumper::Terse = 1; + +while (my $attr = $attrs->Next ) { + my $user = RT::User->new( RT->SystemUser ); + my ($val, $msg) = $user->Load($attr->ObjectId); + unless ($val) { + RT->Logger->warn("Unable to load User ".$attr->ObjectId." $msg"); + next; + } + next if $user->Disabled; + + my $content = $attr->Content; + if ( my $config_name = $opt{option} ) { + if ( exists $content->{$config_name} ) { + my $setting = $content->{$config_name}; + print $user->Name, "\t$config_name: $setting\n"; + } + } else { + print $user->Name, " => ", Dumper($content); + } + +} + +__END__ + +=head1 NAME + +rt-preferences-viewer - show user defined preferences + +=head1 SYNOPSIS + + rt-preferences-viewer + + rt-preferences-viewer --user=falcone + show only the falcone user's preferences + + rt-preferences-viewer --option=EmailFrequency + show users who have set the EmailFrequence config option + +=head1 DESCRIPTION + +This script shows user settings of preferences. If a user is using the system +default, it will not be listed. You can limit to a user name or id or to users +with a particular option set. diff --git a/rt/sbin/rt-server b/rt/sbin/rt-server new file mode 100755 index 000000000..c451a7370 --- /dev/null +++ b/rt/sbin/rt-server @@ -0,0 +1,285 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long; +no warnings 'once'; + +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitPluginPaths(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); + +require RT::Handle; +my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + +unless ( $integrity ) { + print STDERR <<EOF; + +RT couldn't connect to the database where tickets are stored. +If this is a new installation of RT, you should visit the URL below +to configure RT and initialize your database. + +If this is an existing RT installation, this may indicate a database +connectivity problem. + +The error RT got back when trying to connect to your database was: + +$msg + +EOF + + require RT::Installer; + # don't enter install mode if the file exists but is unwritable + if (-e RT::Installer->ConfigFile && !-w _) { + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; + } + + RT->Config->Set( 'LexiconLanguages' => '*' ); + RT::I18N->Init; + + RT->InstallMode(1); +} else { + RT->Init( Heavy => 1 ); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh->disconnect if $RT::Handle->dbh; + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + + +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/sbin/rt-server.fcgi b/rt/sbin/rt-server.fcgi new file mode 100755 index 000000000..c451a7370 --- /dev/null +++ b/rt/sbin/rt-server.fcgi @@ -0,0 +1,285 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long; +no warnings 'once'; + +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitPluginPaths(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); + +require RT::Handle; +my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + +unless ( $integrity ) { + print STDERR <<EOF; + +RT couldn't connect to the database where tickets are stored. +If this is a new installation of RT, you should visit the URL below +to configure RT and initialize your database. + +If this is an existing RT installation, this may indicate a database +connectivity problem. + +The error RT got back when trying to connect to your database was: + +$msg + +EOF + + require RT::Installer; + # don't enter install mode if the file exists but is unwritable + if (-e RT::Installer->ConfigFile && !-w _) { + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; + } + + RT->Config->Set( 'LexiconLanguages' => '*' ); + RT::I18N->Init; + + RT->InstallMode(1); +} else { + RT->Init( Heavy => 1 ); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh->disconnect if $RT::Handle->dbh; + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + + +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/sbin/rt-session-viewer b/rt/sbin/rt-session-viewer new file mode 100755 index 000000000..0f6c4e420 --- /dev/null +++ b/rt/sbin/rt-session-viewer @@ -0,0 +1,121 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (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; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +use Getopt::Long; +my %opt; +GetOptions( \%opt, 'help|h', ); + +my $session_id = shift; + +if ( $opt{help} || !$session_id ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; +} + +require RT; +RT::LoadConfig(); +RT::Init(); + +require RT::Interface::Web::Session; +my %session; + +tie %session, 'RT::Interface::Web::Session', $session_id; +unless ( $session{'_session_id'} eq $session_id ) { + print STDERR "Couldn't load session $session_id\n"; + exit 1; +} + +use Data::Dumper; +print "Content of session $session_id: ". Dumper( \%session); + +__END__ + +=head1 NAME + +rt-session-viewer - show the content of a user's session + +=head1 SYNOPSIS + + # show the content of a session + rt-session-viewer 2c21c8a2909c14eff12975dd2cc7b9a3 + +=head1 DESCRIPTION + +This script deserializes and print content of a session identified +by <session id>. May be useful for developers and for troubleshooting +problems. + +=cut diff --git a/rt/sbin/rt-setup-database b/rt/sbin/rt-setup-database new file mode 100755 index 000000000..5d7f21cef --- /dev/null +++ b/rt/sbin/rt-setup-database @@ -0,0 +1,609 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 vars qw($Nobody $SystemUser $item); + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Term::ReadKey; +use Getopt::Long; + +$| = 1; # unbuffer all output. + +my %args = ( + dba => 'freeside', + package => 'RT', +); +GetOptions( + \%args, + 'action=s', + 'force', 'debug', + 'dba=s', 'dba-password=s', 'prompt-for-dba-password', 'package=s', + 'datafile=s', 'datadir=s', 'skip-create', 'root-password-file=s', + 'upgrade-from=s', 'upgrade-to=s', + 'help|h', +); + +no warnings 'once'; +if ( $args{help} || ! $args{'action'} ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitClasses(); + +# Force warnings to be output to STDERR if we're not already logging +# them at a higher level +RT->Config->Set( LogToScreen => 'warning') + unless ( RT->Config->Get( 'LogToScreen' ) + && RT->Config->Get( 'LogToScreen' ) =~ /^(debug|info|notice)$/ ); + +# get customized root password +my $root_password; +if ( $args{'root-password-file'} ) { + open( my $fh, '<', $args{'root-password-file'} ) + or die "Couldn't open 'args{'root-password-file'}' for reading: $!"; + $root_password = <$fh>; + chomp $root_password; + my $min_length = RT->Config->Get('MinimumPasswordLength'); + if ($min_length) { + die +"password needs to be at least $min_length long, please check file '$args{'root-password-file'}'" + if length $root_password < $min_length; + } + close $fh; +} + + +# check and setup @actions +my @actions = grep $_, split /,/, $args{'action'}; +if ( @actions > 1 && $args{'datafile'} ) { + print STDERR "You can not use --datafile option with multiple actions.\n"; + exit(-1); +} +foreach ( @actions ) { + unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) { + print STDERR "$0 called with an invalid --action parameter.\n"; + exit(-1); + } + if ( /^(?:init|drop|upgrade)$/ && @actions > 1 ) { + print STDERR "You can not mix init, drop or upgrade action with any action.\n"; + exit(-1); + } +} + +# convert init to multiple actions +my $init = 0; +if ( $actions[0] eq 'init' ) { + if ($args{'skip-create'}) { + @actions = qw(schema coredata insert); + } else { + @actions = qw(create schema acl coredata insert); + } + $init = 1; +} + +# set options from environment +foreach my $key(qw(Type Host Name User Password)) { + next unless exists $ENV{ 'RT_DB_'. uc $key }; + print "Using Database$key from RT_DB_". uc($key) ." environment variable.\n"; + RT->Config->Set( "Database$key", $ENV{ 'RT_DB_'. uc $key }); +} + +my $db_type = RT->Config->Get('DatabaseType') || ''; +my $db_host = RT->Config->Get('DatabaseHost') || ''; +my $db_port = RT->Config->Get('DatabasePort') || ''; +my $db_name = RT->Config->Get('DatabaseName') || ''; +my $db_user = RT->Config->Get('DatabaseUser') || ''; +my $db_pass = RT->Config->Get('DatabasePassword') || ''; + +# load it here to get error immidiatly if DB type is not supported +require RT::Handle; + +if ( $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name) ) { + $db_name = File::Spec->catfile($RT::VarPath, $db_name); + RT->Config->Set( DatabaseName => $db_name ); +} + +my $dba_user = $args{'dba'} || $ENV{'RT_DBA_USER'} || $db_user || ''; +my $dba_pass = exists($args{'dba-password'}) + ? $args{'dba-password'} + : $ENV{'RT_DBA_PASSWORD'}; + +if ($args{'skip-create'}) { + $dba_user = $db_user; + $dba_pass = $db_pass; +} else { + if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) { + $dba_pass = get_dba_password(); + chomp $dba_pass if defined($dba_pass); + } +} + +my $version_word_regex = join '|', RT::Handle->version_words; +my $version_dir = qr/^\d+\.\d+\.\d+(?:$version_word_regex)?\d*$/; + +print "Working with:\n" + ."Type:\t$db_type\nHost:\t$db_host\nPort:\t$db_port\nName:\t$db_name\n" + ."User:\t$db_user\nDBA:\t$dba_user" . ($args{'skip-create'} ? ' (No DBA)' : '') . "\n"; + +foreach my $action ( @actions ) { + no strict 'refs'; + my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args ); + error($action, $msg) unless $status; + print $msg .".\n" if $msg; + print "Done.\n"; +} + +sub action_create { + my %args = @_; + my $dbh = get_system_dbh(); + my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'create' ); + return ($status, $msg) unless $status; + + print "Now creating a $db_type database $db_name for RT.\n"; + return RT::Handle->CreateDatabase( $dbh ); +} + +sub action_drop { + my %args = @_; + + print "Dropping $db_type database $db_name.\n"; + unless ( $args{'force'} ) { + print <<END; + +About to drop $db_type database $db_name on $db_host (port '$db_port'). +WARNING: This will erase all data in $db_name. + +END + exit(-2) unless _yesno(); + } + + my $dbh = get_system_dbh(); + return RT::Handle->DropDatabase( $dbh ); +} + +sub action_schema { + my %args = @_; + my $dbh = get_admin_dbh(); + my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'schema' ); + return ($status, $msg) unless $status; + + print "Now populating database schema.\n"; + return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} ); +} + +sub action_acl { + my %args = @_; + my $dbh = get_admin_dbh(); + my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'acl' ); + return ($status, $msg) unless $status; + + print "Now inserting database ACLs.\n"; + return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} ); +} + +sub action_coredata { + my %args = @_; + $RT::Handle = RT::Handle->new; + $RT::Handle->dbh( undef ); + RT::ConnectToDatabase(); + RT::InitLogging(); + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'coredata' ); + return ($status, $msg) unless $status; + + print "Now inserting RT core system objects.\n"; + return $RT::Handle->InsertInitialData; +} + +sub action_insert { + my %args = @_; + $RT::Handle = RT::Handle->new; + RT::Init(); + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'insert' ); + return ($status, $msg) unless $status; + + print "Now inserting data.\n"; + my $file = $args{'datafile'}; + $file = $RT::EtcPath . "/initialdata" if $init && !$file; + $file ||= $args{'datadir'}."/content"; + + # Slurp in backcompat + my %removed; + my @back = @{$args{backcompat} || []}; + if (@back) { + my @lines = do {local @ARGV = @back; <>}; + for (@lines) { + s/\#.*//; + next unless /\S/; + my ($class, @fields) = split; + $class->_BuildTableAttributes; + $RT::Logger->debug("Temporarily removing @fields from $class"); + $removed{$class}{$_} = delete $RT::Record::_TABLE_ATTR->{$class}{$_} + for @fields; + } + } + + my @ret = $RT::Handle->InsertData( $file, $root_password ); + + # Put back the fields we chopped off + for my $class (keys %removed) { + $RT::Record::_TABLE_ATTR->{$class}{$_} = $removed{$class}{$_} + for keys %{$removed{$class}}; + } + return @ret; +} + +sub action_upgrade { + my %args = @_; + my $base_dir = $args{'datadir'} || "./etc/upgrade"; + return (0, "Couldn't read dir '$base_dir' with upgrade data") + unless -d $base_dir || -r _; + + my $upgrading_from = undef; + do { + if ( defined $upgrading_from ) { + print "Doesn't match #.#.#: "; + } else { + print "Enter $args{package} version you're upgrading from: "; + } + $upgrading_from = $args{'upgrade-from'} || scalar <STDIN>; + chomp $upgrading_from; + $upgrading_from =~ s/\s+//g; + } while $upgrading_from !~ /$version_dir/; + + my $upgrading_to = $RT::VERSION; + return (0, "The current version $upgrading_to is lower than $upgrading_from") + if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) > 0; + + return (1, "The version $upgrading_to you're upgrading to is up to date") + if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0; + + my @versions = get_versions_from_to($base_dir, $upgrading_from, undef); + return (1, "No DB changes since $upgrading_from") + unless @versions; + + if (RT::Handle::cmp_version($versions[-1], $upgrading_to) > 0) { + print "\n***** There are upgrades for $versions[-1], which is later than $upgrading_to,\n"; + print "***** which you are nominally upgrading to. Upgrading to $versions[-1] instead.\n"; + $upgrading_to = $versions[-1]; + } + + print "\nGoing to apply following upgrades:\n"; + print map "* $_\n", @versions; + + { + my $custom_upgrading_to = undef; + do { + if ( defined $custom_upgrading_to ) { + print "Doesn't match #.#.#: "; + } else { + print "\nEnter $args{package} version if you want to stop upgrade at some point,\n"; + print " or leave it blank if you want apply above upgrades: "; + } + $custom_upgrading_to = $args{'upgrade-to'} || scalar <STDIN>; + chomp $custom_upgrading_to; + $custom_upgrading_to =~ s/\s+//g; + last unless $custom_upgrading_to; + } while $custom_upgrading_to !~ /$version_dir/; + + if ( $custom_upgrading_to ) { + return ( + 0, "The version you entered ($custom_upgrading_to) is lower than\n" + ."version you're upgrading from ($upgrading_from)" + ) if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) > 0; + + return (1, "The version you're upgrading to is up to date") + if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) == 0; + + if ( RT::Handle::cmp_version( $RT::VERSION, $custom_upgrading_to ) < 0 ) { + print "Version you entered is greater than installed ($RT::VERSION).\n"; + _yesno() or exit(-2); + } + # ok, checked everything no let's refresh list + $upgrading_to = $custom_upgrading_to; + @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to); + + return (1, "No DB changes between $upgrading_from and $upgrading_to") + unless @versions; + + print "\nGoing to apply following upgrades:\n"; + print map "* $_\n", @versions; + } + } + + print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n"; + _yesno() or exit(-2) unless $args{'force'}; + + my ( $ret, $msg ); + foreach my $n ( 0..$#versions ) { + my $v = $versions[$n]; + my @back = grep {-e $_} map {"$base_dir/$versions[$_]/backcompat"} $n+1..$#versions; + print "Processing $v\n"; + my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef, backcompat => \@back); + if ( -e "$base_dir/$v/schema.$db_type" ) { + ( $ret, $msg ) = action_schema( %tmp ); + return ( $ret, $msg ) unless $ret; + } + if ( -e "$base_dir/$v/acl.$db_type" ) { + ( $ret, $msg ) = action_acl( %tmp ); + return ( $ret, $msg ) unless $ret; + } + if ( -e "$base_dir/$v/content" ) { + ( $ret, $msg ) = action_insert( %tmp ); + return ( $ret, $msg ) unless $ret; + } + } + return 1; +} + +sub get_versions_from_to { + my ($base_dir, $from, $to) = @_; + + opendir( my $dh, $base_dir ) or die "couldn't open dir: $!"; + my @versions = grep -d "$base_dir/$_" && /$version_dir/, readdir $dh; + closedir $dh; + + die "\nERROR: No upgrade data found in '$base_dir'! Perhaps you specified the wrong --datadir?\n" + unless @versions; + + return + grep defined $to ? RT::Handle::cmp_version($_, $to) <= 0 : 1, + grep RT::Handle::cmp_version($_, $from) > 0, + sort RT::Handle::cmp_version @versions; +} + +sub error { + my ($action, $msg) = @_; + print STDERR "Couldn't finish '$action' step.\n\n"; + print STDERR "ERROR: $msg\n\n"; + exit(-1); +} + +sub get_dba_password { + print "In order to create or update your RT database," + . " this script needs to connect to your " + . " $db_type instance on $db_host (port '$db_port') as $dba_user\n"; + print "Please specify that user's database password below. If the user has no database\n"; + print "password, just press return.\n\n"; + print "Password: "; + ReadMode('noecho'); + my $password = ReadLine(0); + ReadMode('normal'); + print "\n"; + return ($password); +} + +# get_system_dbh +# Returns L<DBI> database handle connected to B<system> with DBA credentials. +# See also L<RT::Handle/SystemDSN>. + + +sub get_system_dbh { + return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass ); +} + +sub get_admin_dbh { + return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass ); +} + +# get_rt_dbh [USER, PASSWORD] + +# Returns L<DBI> database handle connected to RT database, +# you may specify credentials(USER and PASSWORD) to connect +# with. By default connects with credentials from RT config. + +sub get_rt_dbh { + return _get_dbh( RT::Handle->DSN, $db_user, $db_pass ); +} + +sub _get_dbh { + my ($dsn, $user, $pass) = @_; + my $dbh = DBI->connect( + $dsn, $user, $pass, + { RaiseError => 0, PrintError => 0 }, + ); + unless ( $dbh ) { + my $msg = "Failed to connect to $dsn as user '$user': ". $DBI::errstr; + if ( $args{'debug'} ) { + require Carp; Carp::confess( $msg ); + } else { + print STDERR $msg; exit -1; + } + } + return $dbh; +} + +sub _yesno { + print "Proceed [y/N]:"; + my $x = scalar(<STDIN>); + $x =~ /^y/i; +} + +1; + +__END__ + +=head1 NAME + +rt-setup-database - Set up RT's database + +=head1 SYNOPSIS + + rt-setup-database --action ... + +=head1 OPTIONS + +=over + +=item action + +Several actions can be combined using comma separated list. + +=over + +=item init + +Initialize the database. This is combination of multiple actions listed below. +Create DB, schema, setup acl, insert core data and initial data. + +=item upgrade + +Apply all needed schema/acl/content updates (will ask for version to upgrade +from) + +=item create + +Create the database. + +=item drop + +Drop the database. This will B<ERASE ALL YOUR DATA>. + +=item schema + +Initialize only the database schema + +To use a local or supplementary datafile, specify it using the '--datadir' +option below. + +=item acl + +Initialize only the database ACLs + +To use a local or supplementary datafile, specify it using the '--datadir' +option below. + +=item coredata + +Insert data into RT's database. This data is required for normal functioning of +any RT instance. + +=item insert + +Insert data into RT's database. By default, will use RT's installation data. +To use a local or supplementary datafile, specify it using the '--datafile' +option below. + +=back + +=item datafile + +file path of the data you want to action on + +e.g. C<--datafile /path/to/datafile> + +=item datadir + +Used to specify a path to find the local database schema and acls to be +installed. + +e.g. C<--datadir /path/to/> + +=item dba + +dba's username + +=item dba-password + +dba's password + +=item prompt-for-dba-password + +Ask for the database administrator's password interactively + +=item skip-create + +for 'init': skip creating the database and the user account, so we don't need +administrator privileges + +=item root-password-file + +for 'init' and 'insert': rather than using the default administrative password +for RT's "root" user, use the password in this file. + +=item upgrade-from + +for 'upgrade': specifies the version to upgrade from, and do not prompt +for it if it appears to be a valid version. + +=item upgrade-to + +for 'upgrade': specifies the version to upgrade to, and do not prompt +for it if it appears to be a valid version. + +=back diff --git a/rt/sbin/rt-setup-fulltext-index b/rt/sbin/rt-setup-fulltext-index new file mode 100755 index 000000000..e27a27010 --- /dev/null +++ b/rt/sbin/rt-setup-fulltext-index @@ -0,0 +1,720 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; +no warnings 'once'; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +BEGIN { + use RT; + RT::LoadConfig(); + RT::Init(); +}; +use RT::Interface::CLI (); + +my %DB = ( + type => scalar RT->Config->Get('DatabaseType'), + user => scalar RT->Config->Get('DatabaseUser'), + admin => 'freeside', + admin_password => undef, +); + +my %OPT = ( + help => 0, + ask => 1, + dryrun => 0, + attachments => 1, +); + +my %DEFAULT; +if ( $DB{'type'} eq 'Pg' ) { + %DEFAULT = ( + table => 'Attachments', + column => 'ContentIndex', + ); +} +elsif ( $DB{'type'} eq 'mysql' ) { + %DEFAULT = ( + table => 'AttachmentsIndex', + ); +} +elsif ( $DB{'type'} eq 'Oracle' ) { + %DEFAULT = ( + prefix => 'rt_fts_', + ); +} + +use Getopt::Long qw(GetOptions); +GetOptions( + 'h|help!' => \$OPT{'help'}, + 'ask!' => \$OPT{'ask'}, + 'dry-run!' => \$OPT{'dryrun'}, + 'attachments!' => \$OPT{'attachments'}, + + 'table=s' => \$OPT{'table'}, + 'column=s' => \$OPT{'column'}, + 'url=s' => \$OPT{'url'}, + 'maxmatches=i' => \$OPT{'maxmatches'}, + 'index-type=s' => \$OPT{'index-type'}, + + 'dba=s' => \$DB{'admin'}, + 'dba-password=s' => \$DB{'admin_password'}, +) or show_help(); + +if ( $OPT{'help'} || (!$DB{'admin'} && $DB{'type'} eq 'Oracle' ) ) { + show_help( !$OPT{'help'} ); +} + +my $dbh = $RT::Handle->dbh; +$dbh->{'RaiseError'} = 1; +$dbh->{'PrintError'} = 1; + +if ( $DB{'type'} eq 'mysql' ) { + check_sphinx(); + my $table = $OPT{'table'} || prompt( + message => "Enter name of a new MySQL table that will be used to connect to the\n" + . "Sphinx server:", + default => $DEFAULT{'table'}, + silent => !$OPT{'ask'}, + ); + + my $url = 'sphinx://localhost:3312/rt'; + my $version = ($dbh->selectrow_array("show variables like 'version'"))[1]; + $url = 'sphinx://127.0.0.1:3312/rt' + if $version and $version =~ /^(\d+\.\d+)/ and $1 >= 5.5; + + $url = $OPT{'url'} || prompt( + message => "Enter URL of the sphinx search server; this should be of the form\n" + . "sphinx://<server>:<port>/<index name>", + default => $url, + silent => !$OPT{'ask'}, + ); + my $maxmatches = $OPT{'maxmatches'} || prompt( + message => "Maximum number of matches to return; this is the maximum number of\n" + . "attachment records returned by the search, not the maximum number\n" + . "of tickets. Both your RT_SiteConfig.pm and your sphinx.conf must\n" + . "agree on this value. Larger values cause your Sphinx server to\n" + . "consume more memory and CPU time per query.", + default => 10000, + silent => !$OPT{'ask'}, + ); + + my $schema = <<END; +CREATE TABLE $table ( + id INTEGER UNSIGNED NOT NULL, + weight INTEGER NOT NULL, + query VARCHAR(3072) NOT NULL, + INDEX(query) +) ENGINE=SPHINX CONNECTION="$url" CHARACTER SET utf8 +END + + do_error_is_ok( dba_handle() => "DROP TABLE $table" ) + unless $OPT{'dryrun'}; + insert_schema( $schema ); + + print_rt_config( Table => $table, MaxMatches => $maxmatches ); + + require URI; + my $urlo = URI->new( $url ); + my ($host, $port) = split /:/, $urlo->authority; + my $index = $urlo->path; + $index =~ s{^/+}{}; + + my $var_path = $RT::VarPath; + + my %sphinx_conf = (); + $sphinx_conf{'host'} = RT->Config->Get('DatabaseHost'); + $sphinx_conf{'db'} = RT->Config->Get('DatabaseName'); + $sphinx_conf{'user'} = RT->Config->Get('DatabaseUser'); + $sphinx_conf{'pass'} = RT->Config->Get('DatabasePassword'); + + print <<END + +Below is a simple Sphinx configuration which can be used to index all +text/plain attachments in your database. This configuration is not +ideal; you should read the Sphinx documentation to understand how to +configure it to better suit your needs. + +source rt { + type = mysql + + sql_host = $sphinx_conf{'host'} + sql_db = $sphinx_conf{'db'} + sql_user = $sphinx_conf{'user'} + sql_pass = $sphinx_conf{'pass'} + + sql_query_pre = SET NAMES utf8 + sql_query = \\ + SELECT a.id, a.content FROM Attachments a \\ + JOIN Transactions txn ON a.TransactionId = txn.id AND txn.ObjectType = 'RT::Ticket' \\ + JOIN Tickets t ON txn.ObjectId = t.id \\ + WHERE a.ContentType = 'text/plain' AND t.Status != 'deleted' + + sql_query_info = SELECT * FROM Attachments WHERE id=\$id +} + +index $index { + source = rt + path = $var_path/sphinx/index + docinfo = extern + charset_type = utf-8 +} + +indexer { + mem_limit = 32M +} + +searchd { + port = $port + log = $var_path/sphinx/searchd.log + query_log = $var_path/sphinx/query.log + read_timeout = 5 + max_children = 30 + pid_file = $var_path/sphinx/searchd.pid + max_matches = $maxmatches + seamless_rotate = 1 + preopen_indexes = 0 + unlink_old = 1 +} + +END + +} +elsif ( $DB{'type'} eq 'Pg' ) { + check_tsvalue(); + my $table = $OPT{'table'} || prompt( + message => "Enter the name of a DB table that will be used to store the Pg tsvector.\n" + . "You may either use the existing Attachments table, or create a new\n" + . "table.", + default => $DEFAULT{'table'}, + silent => !$OPT{'ask'}, + ); + my $column = $OPT{'column'} || prompt( + message => 'Enter the name of a column that will be used to store the Pg tsvector:', + default => $DEFAULT{'column'}, + silent => !$OPT{'ask'}, + ); + + my $schema; + my $drop; + if ( lc($table) eq 'attachments' ) { + $drop = "ALTER TABLE $table DROP COLUMN $column"; + $schema = "ALTER TABLE $table ADD COLUMN $column tsvector"; + } else { + $drop = "DROP TABLE $table"; + $schema = "CREATE TABLE $table ( " + ."id INTEGER NOT NULL," + ."$column tsvector )"; + } + + my $index_type = lc($OPT{'index-type'} || ''); + while ( $index_type ne 'gist' and $index_type ne 'gin' ) { + $index_type = lc prompt( + message => "You may choose between GiST or GIN indexes; the former is several times\n" + . "slower to search, but takes less space on disk and is faster to update.", + default => 'GiST', + silent => !$OPT{'ask'}, + ); + } + + do_error_is_ok( dba_handle() => $drop ) + unless $OPT{'dryrun'}; + insert_schema( $schema ); + insert_schema("CREATE INDEX ${column}_idx ON $table USING $index_type($column)"); + + print_rt_config( Table => $table, Column => $column ); +} +elsif ( $DB{'type'} eq 'Oracle' ) { + { + my $dbah = dba_handle(); + do_print_error( $dbah => 'GRANT CTXAPP TO '. $DB{'user'} ); + do_print_error( $dbah => 'GRANT EXECUTE ON CTXSYS.CTX_DDL TO '. $DB{'user'} ); + } + + my %PREFERENCES = ( + datastore => { + type => 'DIRECT_DATASTORE', + }, + filter => { + type => 'AUTO_FILTER', +# attributes => { +# timeout => 120, # seconds +# timeout_type => 'HEURISTIC', # or 'FIXED' +# }, + }, + lexer => { + type => 'WORLD_LEXER', + }, + word_list => { + type => 'BASIC_WORDLIST', + attributes => { + stemmer => 'AUTO', + fuzzy_match => 'AUTO', +# fuzzy_score => undef, +# fuzzy_numresults => undef, +# substring_index => undef, +# prefix_index => undef, +# prefix_length_min => undef, +# prefix_length_max => undef, +# wlidcard_maxterms => undef, + }, + }, + 'section_group' => { + type => 'NULL_SECTION_GROUP', + }, + + storage => { + type => 'BASIC_STORAGE', + attributes => { + R_TABLE_CLAUSE => 'lob (data) store as (cache)', + I_INDEX_CLAUSE => 'compress 2', + }, + }, + ); + + my @params = (); + push @params, ora_create_datastore( %{ $PREFERENCES{'datastore'} } ); + push @params, ora_create_filter( %{ $PREFERENCES{'filter'} } ); + push @params, ora_create_lexer( %{ $PREFERENCES{'lexer'} } ); + push @params, ora_create_word_list( %{ $PREFERENCES{'word_list'} } ); + push @params, ora_create_stop_list(); + push @params, ora_create_section_group( %{ $PREFERENCES{'section_group'} } ); + push @params, ora_create_storage( %{ $PREFERENCES{'storage'} } ); + + my $index_params = join "\n", @params; + my $index_name = $DEFAULT{prefix} .'index'; + do_error_is_ok( $dbh => "DROP INDEX $index_name" ) + unless $OPT{'dryrun'}; + $dbh->do( + "CREATE INDEX $index_name ON Attachments(Content) + indextype is ctxsys.context parameters(' + $index_params + ')", + ) unless $OPT{'dryrun'}; + + print_rt_config( IndexName => $index_name ); +} +else { + die "Full-text indexes on $DB{type} are not yet supported"; +} + +sub check_tsvalue { + my $dbh = $RT::Handle->dbh; + my $fts = ($dbh->selectrow_array(<<EOQ))[0]; +SELECT 1 FROM information_schema.routines WHERE routine_name = 'plainto_tsquery' +EOQ + unless ($fts) { + print STDERR <<EOT; + +Your PostgreSQL server does not include full-text support. You will +need to upgrade to PostgreSQL version 8.3 or higher to use full-text +indexing. + +EOT + exit 1; + } +} + +sub check_sphinx { + return if $RT::Handle->CheckSphinxSE; + + print STDERR <<EOT; + +Your MySQL server has not been compiled with the Sphinx storage engine +(sphinxse). You will need to recompile MySQL according to the +instructions in Sphinx's documentation at +http://sphinxsearch.com/docs/current.html#sphinxse-installing + +EOT + exit 1; +} + +sub ora_create_datastore { + return sprintf 'datastore %s', ora_create_preference( + @_, + name => 'datastore', + ); +} + +sub ora_create_filter { + my $res = ''; + $res .= sprintf "format column %s\n", ora_create_format_column(); + $res .= sprintf 'filter %s', ora_create_preference( + @_, + name => 'filter', + ); + return $res; +} + +sub ora_create_lexer { + return sprintf 'lexer %s', ora_create_preference( + @_, + name => 'lexer', + ); +} + +sub ora_create_word_list { + return sprintf 'wordlist %s', ora_create_preference( + @_, + name => 'word_list', + ); +} + +sub ora_create_stop_list { + my $file = shift || 'etc/stopwords/en.txt'; + return '' unless -e $file; + + my $name = $DEFAULT{'prefix'} .'stop_list'; + unless ($OPT{'dryrun'}) { + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_stoplist(?); end;', $name ); + + $dbh->do( + 'begin ctx_ddl.create_stoplist(?, ?); end;', + undef, $name, 'BASIC_STOPLIST' + ); + + open( my $fh, '<:utf8', $file ) + or die "couldn't open file '$file': $!"; + while ( my $word = <$fh> ) { + chomp $word; + $dbh->do( + 'begin ctx_ddl.add_stopword(?, ?); end;', + undef, $name, $word + ); + } + close $fh; + } + return sprintf 'stoplist %s', $name; +} + +sub ora_create_section_group { + my %args = @_; + my $name = $DEFAULT{'prefix'} .'section_group'; + unless ($OPT{'dryrun'}) { + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_section_group(?); end;', $name ); + $dbh->do( + 'begin ctx_ddl.create_section_group(?, ?); end;', + undef, $name, $args{'type'} + ); + } + return sprintf 'section group %s', $name; +} + +sub ora_create_storage { + return sprintf 'storage %s', ora_create_preference( + @_, + name => 'storage', + ); +} + +sub ora_create_format_column { + my $column_name = 'ContentOracleFormat'; + return $column_name if $OPT{'dryrun'}; + unless ( + $dbh->column_info( + undef, undef, uc('Attachments'), uc( $column_name ) + )->fetchrow_array + ) { + $dbh->do(qq{ + ALTER TABLE Attachments ADD $column_name VARCHAR2(10) + }); + } + + my $detect_format = qq{ + CREATE OR REPLACE FUNCTION $DEFAULT{prefix}detect_format_simple( + parent IN NUMBER, + type IN VARCHAR2, + encoding IN VARCHAR2, + fname IN VARCHAR2 + ) + RETURN VARCHAR2 + AS + format VARCHAR2(10); + BEGIN + format := CASE + }; + unless ( $OPT{'attachments'} ) { + $detect_format .= qq{ + WHEN fname IS NOT NULL THEN 'ignore' + }; + } + $detect_format .= qq{ + WHEN type = 'text' THEN 'text' + WHEN type = 'text/rtf' THEN 'ignore' + WHEN type LIKE 'text/%' THEN 'text' + WHEN type LIKE 'message/%' THEN 'text' + ELSE 'ignore' + END; + RETURN format; + END; + }; + ora_create_procedure( $detect_format ); + + $dbh->do(qq{ + UPDATE Attachments + SET $column_name = $DEFAULT{prefix}detect_format_simple( + Parent, + ContentType, ContentEncoding, + Filename + ) + WHERE $column_name IS NULL + }); + $dbh->do(qq{ + CREATE OR REPLACE TRIGGER $DEFAULT{prefix}set_format + BEFORE INSERT + ON Attachments + FOR EACH ROW + BEGIN + :new.$column_name := $DEFAULT{prefix}detect_format_simple( + :new.Parent, + :new.ContentType, :new.ContentEncoding, + :new.Filename + ); + END; + }); + return $column_name; +} + +sub ora_create_preference { + my %info = @_; + my $name = $DEFAULT{'prefix'} . $info{'name'}; + return $name if $OPT{'dryrun'}; + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_preference(?); end;', $name ); + $dbh->do( + 'begin ctx_ddl.create_preference(?, ?); end;', + undef, $name, $info{'type'} + ); + return $name unless $info{'attributes'}; + + while ( my ($attr, $value) = each %{ $info{'attributes'} } ) { + $dbh->do( + 'begin ctx_ddl.set_attribute(?, ?, ?); end;', + undef, $name, $attr, $value + ); + } + + return $name; +} + +sub ora_create_procedure { + my $text = shift; + + return if $OPT{'dryrun'}; + my $status = $dbh->do($text, { RaiseError => 0 }); + + # Statement succeeded + return if $status; + + if ( 6550 != $dbh->err ) { + # Utter failure + die $dbh->errstr; + } + else { + my $msg = $dbh->func( 'plsql_errstr' ); + die $dbh->errstr if !defined $msg; + die $msg if $msg; + } +} + +sub dba_handle { + if ( $DB{'type'} eq 'Oracle' ) { + $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8"; + $ENV{'NLS_NCHAR'} = "AL32UTF8"; + } + my $dsn = do { my $h = new RT::Handle; $h->BuildDSN; $h->DSN }; + my $dbh = DBI->connect( + $dsn, $DB{admin}, $DB{admin_password}, + { RaiseError => 1, PrintError => 1 }, + ); + unless ( $dbh ) { + die "Failed to connect to $dsn as user '$DB{admin}': ". $DBI::errstr; + } + return $dbh; +} + +sub do_error_is_ok { + my $dbh = shift; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 0; + return $dbh->do(shift, undef, @_); +} + +sub do_print_error { + my $dbh = shift; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 1; + return $dbh->do(shift, undef, @_); +} + +sub prompt { + my %args = ( @_ ); + return $args{'default'} if $args{'silent'}; + + local $| = 1; + print $args{'message'}; + if ( $args{'default'} ) { + print "\n[". $args{'default'} .']: '; + } else { + print ":\n"; + } + + my $res = <STDIN>; + chomp $res; + print "\n"; + return $args{'default'} if !$res && $args{'default'}; + return $res; +} + +sub verbose { print @_, "\n" if $OPT{verbose} || $OPT{verbose}; 1 } +sub debug { print @_, "\n" if $OPT{debug}; 1 } +sub error { $RT::Logger->error( @_ ); verbose(@_); 1 } +sub warning { $RT::Logger->warning( @_ ); verbose(@_); 1 } + +sub show_help { + my $error = shift; + RT::Interface::CLI->ShowHelp( + ExitValue => $error, + Sections => 'NAME|DESCRIPTION', + ); +} + +sub print_rt_config { + my %args = @_; + my $config = <<END; + +You can now configure RT to use the newly-created full-text index by +adding the following to your RT_SiteConfig.pm: + +Set( %FullTextSearch, + Enable => 1, + Indexed => 1, +END + + $config .= sprintf(" %-10s => '$args{$_}',\n",$_) + foreach grep defined $args{$_}, keys %args; + $config .= ");\n"; + + print $config; +} + +sub insert_schema { + my $dbh = dba_handle(); + my $message = "Going to run the following in the DB:"; + my $schema = shift; + print "$message\n"; + my $disp = $schema; + $disp =~ s/^/ /mg; + print "$disp\n\n"; + return if $OPT{'dryrun'}; + + my $res = $dbh->do( $schema ); + unless ( $res ) { + die "Couldn't run DDL query: ". $dbh->errstr; + } +} + +=head1 NAME + +rt-setup-fulltext-index - Create indexes for full text search + +=head1 DESCRIPTION + +This script creates the appropriate tables, columns, functions, and / or +views necessary for full-text searching for your database type. It will +drop any existing indexes in the process. + +Please read F<docs/full_text_indexing.pod> for complete documentation on +full-text indexing for your database type. + +If you have a non-standard database administrator user or password, you +may use the C<--dba> and C<--dba-password> parameters to set them +explicitly: + + rt-setup-fulltext-index --dba sysdba --dba-password 'secret' + +To test what will happen without running any DDL, pass the C<--dryrun> +flag. + +The Oracle index determines which content-types it will index at +creation time. By default, textual message bodies and textual uploaded +attachments (attachments with filenames) are indexed; to ignore textual +attachments, pass the C<--no-attachments> flag when the index is +created. + + +=head1 AUTHOR + +Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>, +Alex Vandiver E<lt>alexmv@bestpractical.comE<gt> + +=cut + diff --git a/rt/sbin/rt-shredder b/rt/sbin/rt-shredder new file mode 100755 index 000000000..27d57a24f --- /dev/null +++ b/rt/sbin/rt-shredder @@ -0,0 +1,325 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} +=head1 NAME + +rt-shredder - Script which wipe out tickets from RT DB + +=head1 SYNOPSIS + + rt-shredder --plugin list + rt-shredder --plugin help-Tickets + rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"' + + rt-shredder --sqldump unshred.sql --plugin ... + rt-shredder --force --plugin ... + +=head1 DESCRIPTION + +rt-shredder - is script that allow you to wipe out objects +from RT DB. This script uses API that L<RT::Shredder> module adds to RT. +Script can be used as example of usage of the shredder API. + +=head1 USAGE + +You can use several options to control which objects script +should wipeout. + +=head1 OPTIONS + +=head2 --sqldump <filename> + +Outputs INSERT queries into file. This dump can be used to restore data +after wiping out. + +By default creates files named F<< <ISO_date>-XXXX.sql >> in the current +directory. + +=head2 --object (DEPRECATED) + +Option has been deprecated, use plugin C<Objects> instead. + +=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]' + +You can use plugins to select RT objects with various conditions. +See also --plugin list and --plugin help options. + +=head2 --plugin list + +Output list of the available plugins. + +=head2 --plugin help-<plugin name> + +Outputs help for specified plugin. + +=head2 --force + +Script doesn't ask any questions. + +=head1 SEE ALSO + +L<RT::Shredder> + +=cut + +use strict; +use warnings FATAL => 'all'; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use RT -init; + +require RT::Shredder; + +use Getopt::Long qw(GetOptions); +use File::Spec (); + +use RT::Shredder::Plugin (); +# prefetch list of plugins +our %plugins = RT::Shredder::Plugin->List; + +our %opt; +parse_args(); + +my $shredder = RT::Shredder->new; + +{ + my $plugin = eval { $shredder->AddDumpPlugin( Arguments => { + file_name => $opt{'sqldump'}, + from_storage => 0, + } ) }; + if( $@ ) { + print STDERR "ERROR: Couldn't open SQL dump file: $@\n"; + exit 1 if $opt{'sqldump'}; + + print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n"; + unless( $opt{'force'} ) { + exit 0 unless prompt_yN( "Do you want to proceed?" ); + } + } else { + print "SQL dump file is '". $plugin->FileName ."'\n"; + } +} + +my @objs = process_plugins( $shredder ); +prompt_delete_objs( \@objs ) unless $opt{'force'}; + +$shredder->PutObjects( Objects => $_ ) foreach @objs; +eval { $shredder->WipeoutAll }; +if( $@ ) { + require RT::Shredder::Exceptions; + if( my $e = RT::Shredder::Exception::Info->caught ) { + print "\nERROR: $e\n\n"; + exit 1; + } + die $@; +} + +sub prompt_delete_objs +{ + my( $objs ) = @_; + unless( @$objs ) { + print "Objects list is empty, try refine search options\n"; + exit 0; + } + my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n"; + foreach my $o( @$objs ) { + $list .= "\t". $o->_AsString ." object\n"; + } + print $list; + exit(0) unless prompt_yN( "Do you want to proceed?" ); +} + +sub prompt_yN +{ + my $text = shift; + print "$text [y/N] "; + unless( <STDIN> =~ /^(?:y|yes)$/i ) { + return 0; + } + return 1; +} + +sub usage +{ + require RT::Shredder::POD; + RT::Shredder::POD::shredder_cli( $0, \*STDOUT ); + exit 1; +} + +sub parse_args +{ + my $tmp; + Getopt::Long::Configure( "pass_through" ); + my @objs = (); + if( GetOptions( 'object=s' => \@objs ) && @objs ) { + print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n"; + exit(1); + } + + my @plugins = (); + if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) { + $opt{'plugin'} = \@plugins; + foreach my $str( @plugins ) { + if( $str =~ /^\s*list\s*$/ ) { + show_plugin_list(); + } elsif( $str =~ /^\s*help-(\w+)\s*$/ ) { + show_plugin_help( $1 ); + } elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) { + print "Couldn't find plugin '$1'\n"; + show_plugin_list(); + } + } + } + + # other options make no sense without previouse + usage() unless keys %opt; + + if( GetOptions( 'force' => \$tmp ) && $tmp ) { + $opt{'force'}++; + } + $tmp = undef; + if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) { + $opt{'sqldump'} = $tmp; + } + return; +} + +sub process_plugins +{ + my $shredder = shift; + + my @res; + foreach my $str( @{ $opt{'plugin'} } ) { + my $plugin = RT::Shredder::Plugin->new; + my( $status, $msg ) = $plugin->LoadByString( $str ); + unless( $status ) { + print STDERR "Couldn't load plugin\n"; + print STDERR "Error: $msg\n"; + exit(1); + } + if ( lc $plugin->Type eq 'search' ) { + push @res, _process_search_plugin( $shredder, $plugin ); + } + elsif ( lc $plugin->Type eq 'dump' ) { + _process_dump_plugin( $shredder, $plugin ); + } + } + return RT::Shredder->CastObjectsToRecords( Objects => \@res ); +} + +sub _process_search_plugin { + my ($shredder, $plugin) = @_; + my ($status, @objs) = $plugin->Run; + unless( $status ) { + print STDERR "Couldn't run plugin\n"; + print STDERR "Error: $objs[1]\n"; + exit(1); + } + + my $msg; + ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder ); + unless( $status ) { + print STDERR "Couldn't set conflicts resolver\n"; + print STDERR "Error: $msg\n"; + exit(1); + } + return @objs; +} + +sub _process_dump_plugin { + my ($shredder, $plugin) = @_; + $shredder->AddDumpPlugin( + Object => $plugin, + ); +} + +sub show_plugin_list +{ + print "Plugins list:\n"; + print "\t$_\n" foreach( grep !/^Base$/, keys %plugins ); + exit(1); +} + +sub show_plugin_help +{ + my( $name ) = @_; + require RT::Shredder::POD; + unless( $plugins{ $name } ) { + print "Couldn't find plugin '$name'\n"; + show_plugin_list(); + } + RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 ); + RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT ); + exit(1); +} + +exit(0); diff --git a/rt/sbin/rt-shredder.in b/rt/sbin/rt-shredder.in index a903728ce..f1e79f8bf 100755 --- a/rt/sbin/rt-shredder.in +++ b/rt/sbin/rt-shredder.in @@ -77,8 +77,8 @@ should wipeout. Outputs INSERT queries into file. This dump can be used to restore data after wiping out. -By default creates files -F<< <RT_home>/var/data/RT-Shredder/<ISO_date>-XXXX.sql >> +By default creates files named F<< <ISO_date>-XXXX.sql >> in the current +directory. =head2 --object (DEPRECATED) diff --git a/rt/sbin/rt-test-dependencies b/rt/sbin/rt-test-dependencies new file mode 100755 index 000000000..99520aaa7 --- /dev/null +++ b/rt/sbin/rt-test-dependencies @@ -0,0 +1,694 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 }}} +# +# This is just a basic script that checks to make sure that all +# the modules needed by RT before you can install it. +# + +use strict; +use warnings; +no warnings qw(numeric redefine); +use Getopt::Long; +use Cwd qw(abs_path); +my %args; +my %deps; +my @orig_argv = @ARGV; +# Save our path because installers or tests can change cwd +my $script_path = abs_path($0); + +GetOptions( + \%args, 'v|verbose', + 'install!', 'with-MYSQL', + 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE', + 'with-ORACLE', 'with-FASTCGI', + 'with-MODPERL1', 'with-MODPERL2', + 'with-STANDALONE', + + 'with-DEV', + + 'with-GPG', + 'with-ICAL', + 'with-SMTP', + 'with-GRAPHVIZ', + 'with-GD', + 'with-DASHBOARDS', + 'with-USERLOGO', + 'with-SSL-MAILGATE', + 'with-HTML-DOC', + + 'download=s', + 'repository=s', + 'list-deps', + 'help|h', +); + +if ( $args{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +# Set up defaults +my %default = ( + 'with-MASON' => 1, + 'with-PSGI' => 0, + 'with-CORE' => 1, + 'with-CLI' => 1, + 'with-MAILGATE' => 1, + 'with-DEV' => 0, + 'with-GPG' => 1, + 'with-ICAL' => 1, + 'with-SMTP' => 1, + 'with-GRAPHVIZ' => 1, + 'with-GD' => 0, + 'with-DASHBOARDS' => 1, + 'with-USERLOGO' => 1, + 'with-SSL-MAILGATE' => 0, + 'with-HTML-DOC' => 0, +); +$args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default; + +{ + my $section; + my %always_show_sections = ( + perl => 1, + users => 1, + ); + + sub section { + my $s = shift; + $section = $s; + print "$s:\n" unless $args{'list-deps'}; + } + + sub print_found { + my $msg = shift; + my $test = shift; + my $extra = shift; + + unless ( $args{'list-deps'} ) { + if ( $args{'v'} or not $test or $always_show_sections{$section} ) { + print "\t$msg ..."; + print $test ? "found" : "MISSING"; + print "\n"; + } + + print "\t\t$extra\n" if defined $extra; + } + } +} + +sub conclude { + my %missing_by_type = @_; + + unless ( $args{'list-deps'} ) { + unless ( keys %missing_by_type ) { + print "\nAll dependencies have been found.\n"; + return; + } + + print "\nSOME DEPENDENCIES WERE MISSING.\n"; + + for my $type ( keys %missing_by_type ) { + my $missing = $missing_by_type{$type}; + + print "$type missing dependencies:\n"; + for my $name ( keys %$missing ) { + my $module = $missing->{$name}; + my $version = $module->{version}; + my $error = $module->{error}; + print_found( $name . ( $version && !$error ? " >= $version" : "" ), + 0, $module->{error} ); + } + } + exit 1; + } +} + +sub text_to_hash { + my %hash; + for my $line ( split /\n/, $_[0] ) { + my($key, $value) = $line =~ /(\S+)\s*(\S*)/; + $value ||= ''; + $hash{$key} = $value; + } + + return %hash; +} +sub set_dep { + my ($name, $module, $version) = @_; + my %list = @{$deps{$name}}; + $list{$module} = ($version || ''); + $deps{$name} = [ %list ]; +} + +$deps{'CORE'} = [ text_to_hash( << '.') ]; +Class::Accessor 0.34 +DateTime 0.44 +DateTime::Locale 0.40 +Digest::base +Digest::MD5 2.27 +Digest::SHA +DBI 1.37 +Class::ReturnValue 0.40 +DBIx::SearchBuilder 1.59 +Text::Template 1.44 +File::ShareDir +File::Spec 0.8 +HTML::Quoted +HTML::Scrubber 0.08 +HTML::TreeBuilder +HTML::FormatText +Log::Dispatch 2.23 +Sys::Syslog 0.16 +Locale::Maketext 1.06 +Locale::Maketext::Lexicon 0.32 +Locale::Maketext::Fuzzy +MIME::Entity 5.425 +Mail::Mailer 1.57 +Email::Address +Text::Wrapper +Time::ParseDate +Time::HiRes +File::Temp 0.19 +Text::Quoted 2.02 +Tree::Simple 1.04 +UNIVERSAL::require +Regexp::Common +Scalar::Util +Module::Versions::Report 1.05 +Cache::Simple::TimedExpiry +Encode 2.39 +CSS::Squish 0.06 +File::Glob +Devel::StackTrace 1.19 +Text::Password::Pronounceable +Devel::GlobalDestruction +List::MoreUtils +Net::CIDR +Regexp::Common::net::CIDR +Regexp::IPv6 +. + +$deps{'MASON'} = [ text_to_hash( << '.') ]; +HTML::Mason 1.43 +Errno +Digest::MD5 2.27 +CGI::Cookie 1.20 +Storable 2.08 +Apache::Session 1.53 +XML::RSS 1.05 +Text::WikiFormat 0.76 +CSS::Squish 0.06 +Devel::StackTrace 1.19 +JSON +IPC::Run3 +. + +$deps{'PSGI'} = [ text_to_hash( << '.') ]; +CGI 3.38 +CGI::PSGI 0.12 +HTML::Mason::PSGIHandler 0.52 +Plack 0.9971 +Plack::Handler::Starlet +CGI::Emulate::PSGI +. +set_dep( PSGI => CGI => 4.00 ) if $] > 5.019003; + + +$deps{'MAILGATE'} = [ text_to_hash( << '.') ]; +Getopt::Long +LWP::UserAgent +Pod::Usage +. + +$deps{'SSL-MAILGATE'} = [ text_to_hash( << '.') ]; +Crypt::SSLeay +Net::SSL +LWP::UserAgent 6.0 +LWP::Protocol::https +Mozilla::CA +. + +$deps{'CLI'} = [ text_to_hash( << '.') ]; +Getopt::Long 2.24 +LWP +HTTP::Request::Common +Text::ParseWords +Term::ReadLine +Term::ReadKey +. + +$deps{'DEV'} = [ text_to_hash( << '.') ]; +Email::Abstract +Test::Email +HTML::Form +HTML::TokeParser +WWW::Mechanize 1.52 +Test::WWW::Mechanize 1.30 +Module::Refresh 0.03 +Test::Expect 0.31 +XML::Simple +File::Find +Test::Deep 0 # needed for shredder tests +String::ShellQuote 0 # needed for gnupg-incoming.t +Log::Dispatch::Perl +Test::Warn +Test::Builder 0.90 # needed for is_passing +Test::MockTime +Log::Dispatch::Perl +Test::WWW::Mechanize::PSGI +Plack::Middleware::Test::StashWarnings 0.08 +Test::LongString +Test::NoWarnings +Locale::PO +. + +$deps{'FASTCGI'} = [ text_to_hash( << '.') ]; +FCGI 0.74 +FCGI::ProcManager +. + +$deps{'MODPERL1'} = [ text_to_hash( << '.') ]; +Apache::Request +Apache::DBI 0.92 +. + +$deps{'MODPERL2'} = [ text_to_hash( << '.') ]; +Apache::DBI +HTML::Mason 1.36 +. + +$deps{'MYSQL'} = [ text_to_hash( << '.') ]; +DBD::mysql 2.1018 +. + +$deps{'ORACLE'} = [ text_to_hash( << '.') ]; +DBD::Oracle +. + +$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ]; +DBIx::SearchBuilder 1.66 +DBD::Pg 1.43 +. + +$deps{'SQLITE'} = [ text_to_hash( << '.') ]; +DBD::SQLite 1.00 +. + +$deps{'GPG'} = [ text_to_hash( << '.') ]; +GnuPG::Interface +PerlIO::eol +. + +$deps{'ICAL'} = [ text_to_hash( << '.') ]; +Data::ICal +. + +$deps{'SMTP'} = [ text_to_hash( << '.') ]; +Net::SMTP +. + +$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ]; +HTML::RewriteAttributes 0.05 +MIME::Types +URI 1.59 +. + +$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ]; +GraphViz +IPC::Run 0.90 +. + +$deps{'GD'} = [ text_to_hash( << '.') ]; +GD +GD::Graph +GD::Text +. + +$deps{'USERLOGO'} = [ text_to_hash( << '.') ]; +Convert::Color +. + +$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ]; +Pod::Simple 3.24 +HTML::Entities +. + +my %AVOID = ( + 'DBD::Oracle' => [qw(1.23)], + 'Email::Address' => [qw(1.893 1.894)], + 'Devel::StackTrace' => [qw(1.28 1.29)], +); + +if ($args{'download'}) { + download_mods(); +} + + +check_perl_version(); + +check_users(); + +my %Missing_By_Type = (); +foreach my $type (sort grep $args{$_}, keys %args) { + next unless ($type =~ /^with-(.*?)$/) and $deps{$1}; + + $type = $1; + section("$type dependencies"); + + my @missing; + my @deps = @{ $deps{$type} }; + + my %missing = test_deps(@deps); + + if ( $args{'install'} ) { + for my $module (keys %missing) { + resolve_dep($module, $missing{$module}{version}); + my $m = $module . '.pm'; + $m =~ s!::!/!g; + if ( delete $INC{$m} ) { + my $symtab = $module . '::'; + no strict 'refs'; + for my $symbol ( keys %{$symtab} ) { + next if substr( $symbol, -2, 2 ) eq '::'; + delete $symtab->{$symbol}; + } + } + delete $missing{$module} + if test_dep($module, $missing{$module}{version}, $AVOID{$module}); + } + } + + $Missing_By_Type{$type} = \%missing if keys %missing; +} + +if ( $args{'install'} && keys %Missing_By_Type ) { + exec($script_path, @orig_argv, '--no-install'); +} +else { + conclude(%Missing_By_Type); +} + +sub test_deps { + my @deps = @_; + + my %missing; + while(@deps) { + my $module = shift @deps; + my $version = shift @deps; + my($test, $error) = test_dep($module, $version, $AVOID{$module}); + my $msg = $module . ($version && !$error ? " >= $version" : ''); + print_found($msg, $test, $error); + + $missing{$module} = { version => $version, error => $error } unless $test; + } + + return %missing; +} + +sub test_dep { + my $module = shift; + my $version = shift; + my $avoid = shift; + + if ( $args{'list-deps'} ) { + print $module, ': ', $version || 0, "\n"; + } + else { + no warnings 'deprecated'; + eval "use $module $version ()"; + if ( my $error = $@ ) { + return 0 unless wantarray; + + $error =~ s/\n(.*)$//s; + $error =~ s/at \(eval \d+\) line \d+\.$//; + undef $error if $error =~ /this is only/; + + return ( 0, $error ); + } + + if ( $avoid ) { + my $version = $module->VERSION; + if ( grep $version eq $_, @$avoid ) { + return 0 unless wantarray; + return (0, "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually."); + } + } + + return 1; + } +} + +sub resolve_dep { + my $module = shift; + my $version = shift; + + print "\nInstall module $module\n"; + + my $ext = $ENV{'RT_FIX_DEPS_CMD'} || $ENV{'PERL_PREFER_CPAN_CLIENT'}; + unless( $ext ) { + my $configured = 1; + { + local @INC = @INC; + if ( $ENV{'HOME'} ) { + unshift @INC, "$ENV{'HOME'}/.cpan"; + } + $configured = eval { require CPAN::MyConfig } || eval { require CPAN::Config }; + } + unless ( $configured ) { + print <<END; +You haven't configured the CPAN shell yet. +Please run `/usr/bin/perl -MCPAN -e shell` to configure it. +END + exit(1); + } + my $rv = eval { require CPAN; CPAN::Shell->install($module) }; + return $rv unless $@; + + print <<END; +Failed to load module CPAN. + +-------- Error --------- +$@ +------------------------ + +When we tried to start installing RT's perl dependencies, +we were unable to load the CPAN client. This module is usually distributed +with Perl. This usually indicates that your vendor has shipped an unconfigured +or incorrectly configured CPAN client. +The error above may (or may not) give you a hint about what went wrong + +You have several choices about how to install dependencies in +this situatation: + +1) use a different tool to install dependencies by running setting the following + shell environment variable and rerunning this tool: + RT_FIX_DEPS_CMD='/usr/bin/perl -MCPAN -e"install %s"' +2) Attempt to configure CPAN by running: + `/usr/bin/perl -MCPAN -e shell` program from shell. + If this fails, you may have to manually upgrade CPAN (see below) +3) Try to update the CPAN client. Download it from: + http://search.cpan.org/dist/CPAN and try again +4) Install each dependency manually by downloading them one by one from + http://search.cpan.org + +END + exit(1); + } + + if( $ext =~ /\%s/) { + $ext =~ s/\%s/$module/g; # sprintf( $ext, $module ); + } else { + $ext .= " $module"; + } + print "\t\tcommand: '$ext'\n"; + return scalar `$ext 1>&2`; +} + +sub download_mods { + my %modules; + use CPAN; + + foreach my $key (keys %deps) { + my @deps = (@{$deps{$key}}); + while (@deps) { + my $mod = shift @deps; + my $ver = shift @deps; + next if ($mod =~ /^(DBD-|Apache-Request)/); + $modules{$mod} = $ver; + } + } + my @mods = keys %modules; + CPAN::get(); + my $moddir = $args{'download'}; + foreach my $mod (@mods) { + $CPAN::Config->{'build_dir'} = $moddir; + CPAN::get($mod); + } + + opendir(DIR, $moddir); + while ( my $dir = readdir(DIR)) { + print "Dir is $dir\n"; + next if ( $dir =~ /^\.\.?$/); + + # Skip things we've previously tagged + my $out = `svn ls $args{'repository'}/tags/$dir`; + next if ($out); + + if ($dir =~ /^(.*)-(.*?)$/) { + `svn_load_dirs -no_user_input -t tags/$dir -v $args{'repository'} dists/$1 $moddir/$dir`; + `rm -rf $moddir/$dir`; + + } + + } + closedir(DIR); + exit; +} + +sub check_perl_version { + section("perl"); + eval {require 5.008003}; + if ($@) { + print_found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer."); + exit(1); + } else { + print_found( sprintf(">=5.8.3(%vd)", $^V), 1 ); + } +} + +sub check_users { + section("users"); + print_found("rt group (freeside)", defined getgrnam("freeside")); + print_found("bin owner (root)", defined getpwnam("root")); + print_found("libs owner (root)", defined getpwnam("root")); + print_found("libs group (bin)", defined getgrnam("bin")); + print_found("web owner (freeside)", defined getpwnam("freeside")); + print_found("web group (freeside)", defined getgrnam("freeside")); +} + +1; + +__END__ + +=head1 NAME + +rt-test-dependencies - test rt's dependencies + +=head1 SYNOPSIS + + rt-test-dependencies + rt-test-dependencies --install + rt-test-dependencies --with-mysql --with-fastcgi + +=head1 DESCRIPTION + +by default, C<rt-test-dependencies> determines whether you have installed all +the perl modules RT needs to run. + +the "RT_FIX_DEPS_CMD" environment variable, if set, will be used instead of +the standard CPAN shell by --install to install any required modules. it will +be called with the module name, or, if "RT_FIX_DEPS_CMD" contains a "%s", will +replace the "%s" with the module name before calling the program. + +=head1 OPTIONS + +=over + +=item install + + install missing modules + +=item verbose + +list the status of all dependencies, rather than just the missing ones. + +-v is equal to --verbose + +=item specify dependencies + +=over + +=item --with-mysql + + database interface for mysql + +=item --with-postgresql + + database interface for postgresql + +=item with-oracle + + database interface for oracle + +=item with-sqlite + + database interface and driver for sqlite (unsupported) + +=item with-fastcgi + + libraries needed to support the fastcgi handler + +=item with-modperl1 + + libraries needed to support the modperl 1 handler + +=item with-modperl2 + + libraries needed to support the modperl 2 handler + +=item with-dev + + tools needed for RT development + +=back + +=back + diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in index d41337a96..19ec297e5 100644 --- a/rt/sbin/rt-test-dependencies.in +++ b/rt/sbin/rt-test-dependencies.in @@ -334,6 +334,7 @@ DBD::Oracle . $deps{'POSTGRESQL'} = [ text_to_hash( << '.') ]; +DBIx::SearchBuilder 1.66 DBD::Pg 1.43 . @@ -382,7 +383,6 @@ HTML::Entities my %AVOID = ( 'DBD::Oracle' => [qw(1.23)], - 'DBD::Pg' => [qw(3.3.0)], 'Email::Address' => [qw(1.893 1.894)], 'Devel::StackTrace' => [qw(1.28 1.29)], ); diff --git a/rt/sbin/rt-validate-aliases b/rt/sbin/rt-validate-aliases new file mode 100755 index 000000000..0953f9300 --- /dev/null +++ b/rt/sbin/rt-validate-aliases @@ -0,0 +1,343 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + 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/sbin/rt-validator b/rt/sbin/rt-validator new file mode 100755 index 000000000..db6c1e914 --- /dev/null +++ b/rt/sbin/rt-validator @@ -0,0 +1,1182 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long; +my %opt = (); +GetOptions( + \%opt, + 'check|c', + 'resolve', + 'force', + 'verbose|v', + 'help|h', +); + +if ( $opt{help} || !$opt{check} ) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +usage_warning() if $opt{'resolve'} && !$opt{'force'}; + + +sub usage_warning { + print <<END; +This utility can fix some issues with DB by creating or updating. In some +cases there is no enough data to resurect a missing record, but records which +refers to a missing can be deleted. It's up to you to decide what to do. + +In any case it's highly recommended to have a backup before resolving anything. + +Press enter to continue. +END +# Read a line of text, any line of text + <STDIN>; +} + +use RT; +RT::LoadConfig(); +RT::Init(); + +my $dbh = $RT::Handle->dbh; +my $db_type = RT->Config->Get('DatabaseType'); + +my %TYPE = ( + 'Transactions.Field' => 'text', + 'Transactions.OldValue' => 'text', + 'Transactions.NewValue' => 'text', +); + +my @models = qw( + ACE + Attachment + Attribute + CachedGroupMember + CustomField + CustomFieldValue + GroupMember + Group + Link + ObjectCustomField + ObjectCustomFieldValue + Principal + Queue + ScripAction + ScripCondition + Scrip + Template + Ticket + Transaction + User +); + +my %redo_on; +$redo_on{'Delete'} = { + ACL => [], + + Attributes => [], + + Links => [], + + CustomFields => [], + CustomFieldValues => [], + ObjectCustomFields => [], + ObjectCustomFieldValues => [], + + Queues => [], + + Scrips => [], + ScripActions => [], + ScripConditions => [], + Templates => [], + + Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ], + Transactions => [ 'Attachments -> other' ], + + Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ], + Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ], + Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ], + + GroupMembers => [ 'CGM vs. GM' ], + CachedGroupMembers => [ 'CGM vs. GM' ], +}; +$redo_on{'Create'} = { + Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ], + Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ], + GroupMembers => [ 'CGM vs. GM' ], + CachedGroupMembers => [ 'CGM vs. GM' ], +}; +$redo_on{'Update'} = { + Groups => ['User Defined Group Name uniqueness'], +}; + +my %describe_cb; +%describe_cb = ( + Attachments => sub { + my $row = shift; + my $txn_id = $row->{transactionid}; + my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id; + return $res .', '. describe( 'Transactions', $txn_id ); + }, + Transactions => sub { + my $row = shift; + return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid}; + }, +); + +{ my %cache = (); +sub m2t($) { + my $model = shift; + return $cache{$model} if $cache{$model}; + my $class = "RT::$model"; + my $object = $class->new( RT->SystemUser ); + return $cache{$model} = $object->Table; +} } + +my (@do_check, %redo_check); + +my @CHECKS; +foreach my $table ( qw(Users Groups) ) { + push @CHECKS, "$table -> Principals" => sub { + my $msg = "A record in $table refers to a nonexistent record in Principals." + ." The script can either create the missing record in Principals" + ." or delete the record in $table."; + my ($type) = ($table =~ /^(.*)s$/); + check_integrity( + $table, 'id' => 'Principals', 'id', + join_condition => 't.PrincipalType = ?', + bind_values => [ $type ], + action => sub { + my $id = shift; + return unless my $a = prompt_action( ['Create', 'delete'], $msg ); + + if ( $a eq 'd' ) { + delete_record( $table, $id ); + } + elsif ( $a eq 'c' ) { + my $principal_id = create_record( 'Principals', + id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0 + ); + } + else { + die "Unknown action '$a'"; + } + }, + ); + }; + + push @CHECKS, "Principals -> $table" => sub { + my $msg = "A record in Principals refers to a nonexistent record in $table." + ." In some cases it's possible to manually resurrect such records," + ." but this utility can only delete records."; + + check_integrity( + 'Principals', 'id' => $table, 'id', + condition => 's.PrincipalType = ?', + bind_values => [ $table =~ /^(.*)s$/ ], + action => sub { + my $id = shift; + return unless prompt( 'Delete', $msg ); + + delete_record( 'Principals', $id ); + }, + ); + }; +} + +push @CHECKS, 'User <-> ACL equivalence group' => sub { + # from user to group + check_integrity( + 'Users', 'id' => 'Groups', 'Instance', + join_condition => 't.Domain = ? AND t.Type = ?', + bind_values => [ 'ACLEquivalence', 'UserEquiv' ], + action => sub { + my $id = shift; + return unless prompt( + 'Create', "Found an user that has no ACL equivalence group." + ); + + my $gid = create_record( 'Groups', + Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id, + ); + }, + ); + # from group to user + check_integrity( + 'Groups', 'Instance' => 'Users', 'id', + condition => 's.Domain = ? AND s.Type = ?', + bind_values => [ 'ACLEquivalence', 'UserEquiv' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found an user ACL equivalence group, but there is no user." + ); + + delete_record( 'Groups', $id ); + }, + ); + # one ACL equiv group for each user + check_uniqueness( + 'Groups', + columns => ['Instance'], + condition => '.Domain = ? AND .Type = ?', + bind_values => [ 'ACLEquivalence', 'UserEquiv' ], + ); +}; + +# check integrity of Queue role groups +push @CHECKS, 'Queues <-> Role Groups' => sub { + # XXX: we check only that there is at least one group for a queue + # from queue to group + check_integrity( + 'Queues', 'id' => 'Groups', 'Instance', + join_condition => 't.Domain = ?', + bind_values => [ 'RT::Queue-Role' ], + ); + # from group to queue + check_integrity( + 'Groups', 'Instance' => 'Queues', 'id', + condition => 's.Domain = ?', + bind_values => [ 'RT::Queue-Role' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a role group of a nonexistent queue." + ); + + delete_record( 'Groups', $id ); + }, + ); +}; + +# check integrity of Ticket role groups +push @CHECKS, 'Tickets <-> Role Groups' => sub { + # XXX: we check only that there is at least one group for a queue + # from queue to group + check_integrity( + 'Tickets', 'id' => 'Groups', 'Instance', + join_condition => 't.Domain = ?', + bind_values => [ 'RT::Ticket-Role' ], + ); + # from group to ticket + check_integrity( + 'Groups', 'Instance' => 'Tickets', 'id', + condition => 's.Domain = ?', + bind_values => [ 'RT::Ticket-Role' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a role group of a nonexistent ticket." + ); + + delete_record( 'Groups', $id ); + }, + ); +}; + +# additional CHECKS on groups +push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub { + # Check that Domain, Instance and Type are unique + check_uniqueness( + 'Groups', + columns => ['Domain', 'Instance', 'Type'], + condition => '.Domain LIKE ?', + bind_values => [ '%-Role' ], + ); +}; + +push @CHECKS, 'System internal group uniqueness' => sub { + check_uniqueness( + 'Groups', + columns => ['Instance', 'Type'], + condition => '.Domain = ?', + bind_values => [ 'SystemInternal' ], + ); +}; + +# CHECK that user defined group names are unique +push @CHECKS, 'User Defined Group Name uniqueness' => sub { + check_uniqueness( + 'Groups', + columns => ['Name'], + condition => '.Domain = ?', + bind_values => [ 'UserDefined' ], + extra_tables => ['Principals sp', 'Principals tp'], + extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)), + extra_values => ['Group', 'Group'], + action => sub { + return unless prompt( + 'Rename', "Found a user defined group with a non-unique Name." + ); + + my $id = shift; + my %cols = @_; + update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) }); + }, + ); +}; + +push @CHECKS, 'GMs -> Groups, Members' => sub { + my $msg = "A record in GroupMembers references an object that doesn't exist." + ." Maybe you deleted a group or principal directly from the database?" + ." Usually it's OK to delete such records."; + check_integrity( + 'GroupMembers', 'GroupId' => 'Groups', 'id', + action => sub { + my $id = shift; + return unless prompt( 'Delete', $msg ); + + delete_record( 'GroupMembers', $id ); + }, + ); + check_integrity( + 'GroupMembers', 'MemberId' => 'Principals', 'id', + action => sub { + my $id = shift; + return unless prompt( 'Delete', $msg ); + + delete_record( 'GroupMembers', $id ); + }, + ); +}; + +# CGM and GM +push @CHECKS, 'CGM vs. GM' => sub { + # all GM record should be duplicated in CGM + check_integrity( + GroupMembers => ['GroupId', 'MemberId'], + CachedGroupMembers => ['GroupId', 'MemberId'], + join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id', + action => sub { + my $id = shift; + return unless prompt( + 'Create', + "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table." + ); + + my $gm = RT::GroupMember->new( RT->SystemUser ); + $gm->Load( $id ); + die "Couldn't load GM record #$id" unless $gm->id; + my $cgm = create_record( 'CachedGroupMembers', + GroupId => $gm->GroupId, MemberId => $gm->MemberId, + ImmediateParentId => $gm->GroupId, Via => undef, + Disabled => 0, # XXX: we should check integrity of Disabled field + ); + update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } ); + }, + ); + # all first level CGM records should have a GM record + check_integrity( + CachedGroupMembers => ['GroupId', 'MemberId'], + GroupMembers => ['GroupId', 'MemberId'], + condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', + "Found a record in CachedGroupMembers for a (Group, Member) pair" + ." that doesn't exist in the GroupMembers table." + ); + + delete_record( 'CachedGroupMembers', $id ); + }, + ); + # each group should have a CGM record where MemberId == GroupId + check_integrity( + Groups => ['id', 'id'], + CachedGroupMembers => ['GroupId', 'MemberId'], + join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id', + action => sub { + my $id = shift; + return unless prompt( + 'Create', + "Found a record in Groups that has no direct" + ." duplicate in CachedGroupMembers table." + ); + + my $g = RT::Group->new( RT->SystemUser ); + $g->Load( $id ); + die "Couldn't load group #$id" unless $g->id; + die "Loaded group by $id has id ". $g->id unless $g->id == $id; + my $cgm = create_record( 'CachedGroupMembers', + GroupId => $id, MemberId => $id, + ImmediateParentId => $id, Via => undef, + Disabled => $g->Disabled, + ); + update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } ); + }, + ); + + # and back, each record in CGM with MemberId == GroupId without exceptions + # should reference a group + check_integrity( + CachedGroupMembers => ['GroupId', 'MemberId'], + Groups => ['id', 'id'], + condition => "s.GroupId = s.MemberId", + action => sub { + my $id = shift; + return unless prompt( + 'Delete', + "Found a record in CachedGroupMembers for a group that doesn't exist." + ); + + delete_record( 'CachedGroupMembers', $id ); + }, + ); + # Via + check_integrity( + CachedGroupMembers => 'Via', + CachedGroupMembers => 'id', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', + "Found a record in CachedGroupMembers with Via that references a nonexistent record." + ); + + delete_record( 'CachedGroupMembers', $id ); + }, + ); + + # for every CGM where ImmediateParentId != GroupId there should be + # matching parent record (first level) + check_integrity( + CachedGroupMembers => ['ImmediateParentId', 'MemberId'], + CachedGroupMembers => ['GroupId', 'MemberId'], + join_condition => 't.Via = t.id', + condition => 's.ImmediateParentId != s.GroupId', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', + "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table." + ); + + delete_record( 'CachedGroupMembers', $id ); + }, + ); + + # for every CGM where ImmediateParentId != GroupId there should be + # matching "grand" parent record + check_integrity( + CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'], + CachedGroupMembers => ['GroupId', 'MemberId', 'id'], + condition => 's.ImmediateParentId != s.GroupId', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', + "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table." + ); + + delete_record( 'CachedGroupMembers', $id ); + }, + ); + + # CHECK recursive records: + # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1, + # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1 + { + my $query = <<END; +SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via, + cgm1.MemberId AS ImmediateParentId, cgm1.Disabled +FROM + CachedGroupMembers cgm1 + CROSS JOIN GroupMembers gm2 + LEFT JOIN CachedGroupMembers cgm3 ON ( + cgm3.GroupId = cgm1.GroupId + AND cgm3.MemberId = gm2.MemberId + AND cgm3.Via = cgm1.id + AND cgm3.ImmediateParentId = cgm1.MemberId ) +WHERE cgm1.GroupId != cgm1.MemberId +AND gm2.GroupId = cgm1.MemberId +AND cgm3.id IS NULL +END + + my $action = sub { + my %props = @_; + return unless prompt( + 'Create', + "Found records in CachedGroupMembers table without recursive duplicates." + ); + my $cgm = create_record( 'CachedGroupMembers', %props ); + }; + + my $sth = execute_query( $query ); + while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) { + print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,"; + print STDERR " but there is no cached GM record that $m is member of #$g.\n"; + $action->( + GroupId => $g, MemberId => $m, Via => $via, + ImmediateParentId => $ip, Disabled => $dis, + ); + } + } +}; + +# Tickets +push @CHECKS, 'Tickets -> other' => sub { + check_integrity( + 'Tickets', 'EffectiveId' => 'Tickets', 'id', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', + "Found a ticket that's been merged into a ticket that no longer exists." + ); + + delete_record( 'Tickets', $id ); + }, + ); + check_integrity( + 'Tickets', 'Queue' => 'Queues', 'id', + ); + check_integrity( + 'Tickets', 'Owner' => 'Users', 'id', + ); + # XXX: check that owner is only member of owner role group +}; + + +push @CHECKS, 'Transactions -> other' => sub { + foreach my $model ( @models ) { + check_integrity( + 'Transactions', 'ObjectId' => m2t($model), 'id', + condition => 's.ObjectType = ?', + bind_values => [ "RT::$model" ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction without object." + ); + + delete_record( 'Transactions', $id ); + }, + ); + } + # type = CustomField + check_integrity( + 'Transactions', 'Field' => 'CustomFields', 'id', + condition => 's.Type = ?', + bind_values => [ 'CustomField' ], + ); + # type = Take, Untake, Force, Steal or Give + check_integrity( + 'Transactions', 'OldValue' => 'Users', 'id', + condition => 's.Type IN (?, ?, ?, ?, ?)', + bind_values => [ qw(Take Untake Force Steal Give) ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction regarding Owner changes," + ." but the User with id stored in OldValue column doesn't exist anymore." + ); + + delete_record( 'Transactions', $id ); + }, + ); + check_integrity( + 'Transactions', 'NewValue' => 'Users', 'id', + condition => 's.Type IN (?, ?, ?, ?, ?)', + bind_values => [ qw(Take Untake Force Steal Give) ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction regarding Owner changes," + ." but the User with id stored in NewValue column doesn't exist anymore." + ); + + delete_record( 'Transactions', $id ); + }, + ); + # type = DelWatcher + check_integrity( + 'Transactions', 'OldValue' => 'Principals', 'id', + condition => 's.Type = ?', + bind_values => [ 'DelWatcher' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction describing watcher changes," + ." but the User with id stored in OldValue column doesn't exist anymore." + ); + + delete_record( 'Transactions', $id ); + }, + ); + # type = AddWatcher + check_integrity( + 'Transactions', 'NewValue' => 'Principals', 'id', + condition => 's.Type = ?', + bind_values => [ 'AddWatcher' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction describing watcher changes," + ." but the User with id stored in NewValue column doesn't exist anymore." + ); + + delete_record( 'Transactions', $id ); + }, + ); + +# XXX: Links need more love, uri is stored instead of id +# # type = DeleteLink +# check_integrity( +# 'Transactions', 'OldValue' => 'Links', 'id', +# condition => 's.Type = ?', +# bind_values => [ 'DeleteLink' ], +# ); +# # type = AddLink +# check_integrity( +# 'Transactions', 'NewValue' => 'Links', 'id', +# condition => 's.Type = ?', +# bind_values => [ 'AddLink' ], +# ); + + # type = Set, Field = Queue + check_integrity( + 'Transactions', 'NewValue' => 'Queues', 'id', + condition => 's.Type = ? AND s.Field = ?', + bind_values => [ 'Set', 'Queue' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction describing a queue change," + ." but the Queue with id stored in the NewValue column doesn't exist anymore." + ); + + delete_record( 'Transactions', $id ); + }, + ); + check_integrity( + 'Transactions', 'OldValue' => 'Queues', 'id', + condition => 's.Type = ? AND s.Field = ?', + bind_values => [ 'Set', 'Queue' ], + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found a transaction describing a queue change," + ." but the Queue with id stored in the OldValue column doesn't exist anymore." + ); + + delete_record( 'Transactions', $id ); + }, + ); + # Reminders + check_integrity( + 'Transactions', 'NewValue' => 'Tickets', 'id', + join_condition => 't.Type = ?', + condition => 's.Type IN (?, ?, ?)', + bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ], + ); +}; + +# Attachments +push @CHECKS, 'Attachments -> other' => sub { + check_integrity( + Attachments => 'TransactionId', Transactions => 'id', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found an attachment without a transaction." + ); + delete_record( 'Attachments', $id ); + }, + ); + check_integrity( + Attachments => 'Parent', Attachments => 'id', + action => sub { + my $id = shift; + return unless prompt( + 'Delete', "Found an sub-attachment without its parent attachment." + ); + delete_record( 'Attachments', $id ); + }, + ); + check_integrity( + Attachments => 'Parent', + Attachments => 'id', + join_condition => 's.TransactionId = t.TransactionId', + ); +}; + +push @CHECKS, 'CustomFields and friends' => sub { + #XXX: ObjectCustomFields needs more love + check_integrity( + 'CustomFieldValues', 'CustomField' => 'CustomFields', 'id', + ); + check_integrity( + 'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id', + ); + foreach my $model ( @models ) { + check_integrity( + 'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id', + condition => 's.ObjectType = ?', + bind_values => [ "RT::$model" ], + ); + } +}; + +push @CHECKS, Templates => sub { + check_integrity( + 'Templates', 'Queue' => 'Queues', 'id', + ); +}; + +push @CHECKS, Scrips => sub { + check_integrity( + 'Scrips', 'Queue' => 'Queues', 'id', + ); + check_integrity( + 'Scrips', 'ScripCondition' => 'ScripConditions', 'id', + ); + check_integrity( + 'Scrips', 'ScripAction' => 'ScripActions', 'id', + ); + check_integrity( + 'Scrips', 'Template' => 'Templates', 'id', + ); +}; + +push @CHECKS, Attributes => sub { + foreach my $model ( @models ) { + check_integrity( + 'Attributes', 'ObjectId' => m2t($model), 'id', + condition => 's.ObjectType = ?', + bind_values => [ "RT::$model" ], + ); + } +}; + +# Fix situations when Creator or LastUpdatedBy references ACL equivalence +# group of a user instead of user +push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub { + my %fix = (); + foreach my $model ( @models ) { + my $class = "RT::$model"; + my $object = $class->new( RT->SystemUser ); + foreach my $column ( qw(LastUpdatedBy Creator) ) { + next unless $object->_Accessible( $column, 'auto' ); + + my $table = m2t($model); + my $query = <<END; +SELECT m.id, g.id, g.Instance +FROM + Groups g JOIN $table m ON g.id = m.$column +WHERE + g.Domain = ? + AND g.Type = ? +END + my $action = sub { + my ($gid, $uid) = @_; + return unless prompt( + 'Update', + "Looks like there were a bug in old versions of RT back in 2006\n" + ."that has been fixed. If other checks are ok then it's ok to update\n" + ."these records to point them to users instead of groups" + ); + $fix{ $table }{ $column }{ $gid } = $uid; + }; + + my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' ); + while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) { + print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid"; + print STDERR " when must reference user.\n"; + $action->( $gid, $uid ); + if ( keys( %fix ) > 1000 ) { + $sth->finish; + last; + } + } + } + } + + if ( keys %fix ) { + foreach my $table ( keys %fix ) { + foreach my $column ( keys %{ $fix{ $table } } ) { + my $query = "UPDATE $table SET $column = ? WHERE $column = ?"; + while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) { + update_records( $table, { $column => $gid }, { $column => $uid } ); + } + } + } + $redo_check{'FIX: LastUpdatedBy and Creator'} = 1; + } +}; + +push @CHECKS, 'LastUpdatedBy and Creator' => sub { + foreach my $model ( @models ) { + my $class = "RT::$model"; + my $object = $class->new( RT->SystemUser ); + my $table = $object->Table; + foreach my $column ( qw(LastUpdatedBy Creator) ) { + next unless $object->_Accessible( $column, 'auto' ); + check_integrity( + $table, $column => 'Users', 'id', + action => sub { + my ($id, %prop) = @_; + return unless my $replace_with = prompt_integer( + 'Replace', + "Column $column should point to a user, but there is record #$id in table $table\n" + ."where it's not true. It's ok to replace these wrong references with id of any user.\n" + ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n" + ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n" + ."or something like that.", + "$table.$column -> user #$prop{$column}" + ); + update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } ); + }, + ); + } + } +}; +my %CHECKS = @CHECKS; + +@do_check = do { my $i = 1; grep $i++%2, @CHECKS }; + +while ( my $check = shift @do_check ) { + $CHECKS{ $check }->(); + + foreach my $redo ( keys %redo_check ) { + die "check $redo doesn't exist" unless $CHECKS{ $redo }; + delete $redo_check{ $redo }; + next if grep $_ eq $redo, @do_check; # don't do twice + push @do_check, $redo; + } +} + +sub check_integrity { + my ($stable, @scols) = (shift, shift); + my ($ttable, @tcols) = (shift, shift); + my %args = @_; + + @scols = @{ $scols[0] } if ref $scols[0]; + @tcols = @{ $tcols[0] } if ref $tcols[0]; + + print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n" + if $opt{'verbose'}; + + my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols) + ." FROM $stable s LEFT JOIN $ttable t" + ." ON (". join( + ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1)) + ) .")" + . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "") + ." WHERE t.id IS NULL" + ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols); + + $query .= " AND ( $args{'condition'} )" if $args{'condition'}; + + my @binds = @{ $args{'bind_values'} || [] }; + if ( $tcols[0] eq 'id' && @tcols == 1 ) { + my $type = $TYPE{"$stable.$scols[0]"} || 'number'; + if ( $type eq 'number' ) { + $query .= " AND s.$scols[0] != ?" + } + elsif ( $type eq 'text' ) { + $query .= " AND s.$scols[0] NOT LIKE ?" + } + push @binds, 0; + } + + my $sth = execute_query( $query, @binds ); + while ( my ($sid, @set) = $sth->fetchrow_array ) { + print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n"; + for ( my $i = 0; $i < @scols; $i++ ) { + print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n"; + } + print STDERR "\t". describe( $stable, $sid ) ."\n"; + $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'}; + } +} + +sub describe { + my ($table, $id) = @_; + return '' unless my $cb = $describe_cb{ $table }; + + my $row = load_record( $table, $id ); + unless ( $row->{id} ) { + $table =~ s/s$//; + return "$table doesn't exist"; + } + return $cb->( $row ); +} + +sub columns_eq_cond { + my ($la, $lt, $lc, $ra, $rt, $rc) = @_; + my $ltype = $TYPE{"$lt.$lc"} || 'number'; + my $rtype = $TYPE{"$rt.$rc"} || 'number'; + return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype; + + if ( $rtype eq 'text' ) { + return "$ra.$rc LIKE CAST($la.$lc AS text)"; + } + elsif ( $ltype eq 'text' ) { + return "$la.$lc LIKE CAST($ra.$rc AS text)"; + } + else { die "don't know how to cast" } +} + +sub check_uniqueness { + my $on = shift; + my %args = @_; + + my @columns = @{ $args{'columns'} }; + + print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n" + if $opt{'verbose'}; + + my ($scond, $tcond); + if ( $scond = $tcond = $args{'condition'} ) { + $scond =~ s/(\s|^)\./$1s./g; + $tcond =~ s/(\s|^)\./$1t./g; + } + + my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns) + ." FROM $on s LEFT JOIN $on t " + ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns) + . ($tcond? " AND ( $tcond )": "") + . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "") + ." WHERE t.id IS NOT NULL " + ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns); + $query .= " AND ( $scond )" if $scond; + $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'}; + + my $sth = execute_query( + $query, + $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (), + $args{'extra_values'}? (@{ $args{'extra_values'} }): () + ); + while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) { + print STDERR "Record #$tid in $on has the same set of values as $sid\n"; + for ( my $i = 0; $i < @columns; $i++ ) { + print STDERR "\t$columns[$i] => '$set[$i]'\n"; + } + $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'}; + } +} + +sub load_record { + my ($table, $id) = @_; + my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id ); + return $sth->fetchrow_hashref('NAME_lc'); +} + +sub delete_record { + my ($table, $id) = (@_); + print "Deleting record #$id in $table\n" if $opt{'verbose'}; + my $query = "DELETE FROM $table WHERE id = ?"; + $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] }; + return execute_query( $query, $id ); +} + +sub create_record { + print "Creating a record in $_[0]\n" if $opt{'verbose'}; + $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] }; + return $RT::Handle->Insert( @_ ); +} + +sub update_records { + my $table = shift; + my $where = shift; + my $what = shift; + + my (@where_cols, @where_binds); + while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; } + + my (@what_cols, @what_binds); + while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; } + + print "Updating record(s) in $table\n" if $opt{'verbose'}; + my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols) + ." WHERE ". join(' AND ', map "$_ = ?", @where_cols); + $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] }; + return execute_query( $query, @what_binds, @where_binds ); +} + +sub execute_query { + my ($query, @binds) = @_; + + print "Executing query: $query\n\n" if $opt{'verbose'}; + + my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr; + $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr; + return $sth; +} + +{ my %cached_answer; +sub prompt { + my $action = shift; + my $msg = shift; + my $token = shift || join ':', caller; + + return 0 unless $opt{'resolve'}; + return 1 if $opt{'force'}; + + return $cached_answer{ $token } if exists $cached_answer{ $token }; + + print $msg, "\n"; + print "$action ALL records with the same defect? [N]: "; + my $a = <STDIN>; + return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i; + return $cached_answer{ $token } = 0; +} } + +{ my %cached_answer; +sub prompt_action { + my $actions = shift; + my $msg = shift; + my $token = shift || join ':', caller; + + return '' unless $opt{'resolve'}; + return lc substr $actions->[0], 0, 1 if $opt{'force'}; + return $cached_answer{ $token } if exists $cached_answer{ $token }; + + print $msg, "\n"; + print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: "; + my $a = <STDIN>; + chomp $a; + return $cached_answer{ $token } = '' unless $a; + foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) { + return $cached_answer{ $token } = lc substr $a, 0, 1; + } + return $cached_answer{ $token } = ''; +} } + +{ my %cached_answer; +sub prompt_integer { + my $action = shift; + my $msg = shift; + my $token = shift || join ':', caller; + + return 0 unless $opt{'resolve'}; + return 0 if $opt{'force'}; + + return $cached_answer{ $token } if exists $cached_answer{ $token }; + + print $msg, "\n"; + print "$action ALL records with the same defect? [0]: "; + my $a = <STDIN>; chomp $a; $a = int($a); + return $cached_answer{ $token } = $a; +} } + +1; + +__END__ + +=head1 NAME + +rt-validator - check and correct validity of records in RT's database + +=head1 SYNOPSIS + + rt-validator --check + rt-validator --check --verbose + rt-validator --check --verbose --resolve + rt-validator --check --verbose --resolve --force + +=head1 DESCRIPTION + +This script checks integrity of records in RT's DB. May delete some invalid +records or ressurect accidentally deleted. + +=head1 OPTIONS + +=over + +=item check + + mandatory. + + it's equal to -c + +=item verbose + + print additional info to STDOUT + it's equal to -v + +=item resolve + + enable resolver that can delete or create some records + +=item force + + resolve without asking questions + +=back + diff --git a/rt/sbin/standalone_httpd b/rt/sbin/standalone_httpd new file mode 100755 index 000000000..c451a7370 --- /dev/null +++ b/rt/sbin/standalone_httpd @@ -0,0 +1,285 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long; +no warnings 'once'; + +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitPluginPaths(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); + +require RT::Handle; +my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + +unless ( $integrity ) { + print STDERR <<EOF; + +RT couldn't connect to the database where tickets are stored. +If this is a new installation of RT, you should visit the URL below +to configure RT and initialize your database. + +If this is an existing RT installation, this may indicate a database +connectivity problem. + +The error RT got back when trying to connect to your database was: + +$msg + +EOF + + require RT::Installer; + # don't enter install mode if the file exists but is unwritable + if (-e RT::Installer->ConfigFile && !-w _) { + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; + } + + RT->Config->Set( 'LexiconLanguages' => '*' ); + RT::I18N->Init; + + RT->InstallMode(1); +} else { + RT->Init( Heavy => 1 ); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh->disconnect if $RT::Handle->dbh; + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + + +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/share/html/Admin/Users/Modify.html b/rt/share/html/Admin/Users/Modify.html index 814e7f996..2483e5b7f 100755 --- a/rt/share/html/Admin/Users/Modify.html +++ b/rt/share/html/Admin/Users/Modify.html @@ -109,7 +109,7 @@ <&| /Widgets/TitleBox, title => loc('Access control') &> <input type="hidden" class="hidden" name="SetEnabled" value="1" /> -<input type="checkbox" class="checkbox" name="Enabled" value="1" <%$EnabledChecked%> /> +<input type="checkbox" class="checkbox" name="Enabled" value="1" <%$EnabledChecked||''%> /> <&|/l&>Let this user access RT</&><br /> diff --git a/rt/share/html/Admin/Users/Modify.html.orig b/rt/share/html/Admin/Users/Modify.html.orig new file mode 100755 index 000000000..814e7f996 --- /dev/null +++ b/rt/share/html/Admin/Users/Modify.html.orig @@ -0,0 +1,421 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +%# <sales@bestpractical.com> +%# +%# (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 }}} +<& /Admin/Elements/Header, Title => $title &> +<& /Elements/Tabs &> + +<& /Elements/ListActions, actions => \@results &> + +<form action="<%RT->Config->Get('WebPath')%>/Admin/Users/Modify.html" method="post" enctype="multipart/form-data"> +%if ($Create) { +<input type="hidden" class="hidden" name="id" value="new" /> +% } else { +<input type="hidden" class="hidden" name="id" value="<%$UserObj->Id%>" /> +% } +<table width="100%" border="0"> +<tr> + +<td valign="top" class="boxcontainer"> +<&| /Widgets/TitleBox, title => loc('Identity') &> + +<table> +<tr><td align="right"> +<&|/l&>Username</&>: +</td><td> +<input name="Name" value="<%$UserObj->Name||$Name||''%>" /> <strong><&|/l&>(required)</&></strong> +</td></tr> +<tr><td align="right"> +<&|/l&>Email</&>: +</td><td> +<input name="EmailAddress" value="<%$UserObj->EmailAddress||$EmailAddress||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Real Name</&>: +</td><td> +<input name="RealName" value="<%$UserObj->RealName||$RealName||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Nickname</&>: +</td><td> +<input name="NickName" value="<%$UserObj->NickName||$NickName||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Unix login</&>: +</td><td> +<input name="Gecos" value="<%$UserObj->Gecos||$Gecos||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Language</&>: +</td><td> +<& /Elements/SelectLang, Name => 'Lang', Default => $UserObj->Lang||$Lang &> +</td></tr> +<tr><td align="right"> +<&|/l&>Extra info</&>: +</td><td> +<textarea name="FreeformContactInfo" cols="20" rows="5"><%$UserObj->FreeformContactInfo||$FreeformContactInfo||''%></textarea> +</td></tr> +</table> +</&> +<br /> + +<&| /Widgets/TitleBox, title => loc('Customers') &> +<& /Elements/EditCustomers, Object => $UserObj, CustomerString=> $CustomerString, ServiceString => $ServiceString &> +</&> +<br /> + +<&| /Widgets/TitleBox, title => loc('Access control') &> +<input type="hidden" class="hidden" name="SetEnabled" value="1" /> +<input type="checkbox" class="checkbox" name="Enabled" value="1" <%$EnabledChecked%> /> +<&|/l&>Let this user access RT</&><br /> + + +<input type="hidden" class="hidden" name="SetPrivileged" value="1" /> +<input type="checkbox" class="checkbox" name="Privileged" value="1" <%$PrivilegedChecked||''%> /> <&|/l&>Let this user be granted rights</&> (<&|/l&>Privileged</&>)<br /> + +<& /Elements/EditPassword, + User => $UserObj, + Name => [qw(CurrentPass Pass1 Pass2)], +&> +</&> +% $m->callback( %ARGS, CallbackName => 'LeftColumnBottom', UserObj => $UserObj ); +</td> + +<td valign="top" class="boxcontainer"> +<&| /Widgets/TitleBox, title => loc('Location') &> +<table> +<tr><td align="right"> +<&|/l&>Organization</&>: +</td><td> +<input name="Organization" value="<%$UserObj->Organization||$Organization||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Address1</&>: +</td><td> +<input name="Address1" value="<%$UserObj->Address1||$Address1||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Address2</&>: +</td><td> +<input name="Address2" value="<%$UserObj->Address2||$Address2||''%>" /> +</td></tr> +<tr><td align="right"> +<&|/l&>City</&>: +</td><td> +<input name="City" value="<%$UserObj->City||$City||''%>" size="14" /> + +</td></tr> +<tr><td align="right"> +<&|/l&>State</&>: +</td><td> +<input name="State" value="<%$UserObj->State||$State||''%>" size="3" /> + +</td></tr> +<tr><td align="right"> +<&|/l&>Zip</&>: +</td><td> +<input name="Zip" value="<%$UserObj->Zip||$Zip||''%>" size="9" /> +</td></tr> +<tr><td align="right"> +<&|/l&>Country</&>: +</td><td> +<input name="Country" value="<%$UserObj->Country||$Country||''%>" /> +</td></tr> +</table> +</&> +<br /> +<&| /Widgets/TitleBox, title => loc('Phone numbers') &> +<table> +<tr><td align="right"> +<&|/l&>Residence</&>: +</td><td> +<input name="HomePhone" value="<%$UserObj->HomePhone||$HomePhone||''%>" size="13" /><br /> +</td></tr> +<tr><td align="right"> +<&|/l&>Work</&>: +</td><td> +<input name="WorkPhone" value="<%$UserObj->WorkPhone||$WorkPhone||''%>" size="13" /><br /> +</td></tr> +<tr><td align="right"> +<&|/l&>Mobile</&>: +</td><td> +<input name="MobilePhone" value="<%$UserObj->MobilePhone||$MobilePhone||''%>" size="13" /><br /> +</td></tr> +<tr><td align="right"> +<&|/l&>Pager</&>: +</td><td> +<input name="PagerPhone" value="<%$UserObj->PagerPhone||$PagerPhone||''%>" size="13" /><br /> +</td> +</tr> +</table> +</&> +<br /> +<&| /Widgets/TitleBox, title => loc('Custom Fields') &> +<table> +% my $CFs = $UserObj->CustomFields; +% while (my $CF = $CFs->Next) { +<tr valign="top"><td align="right"> +<% loc($CF->Name) %>: +</td><td> +% if ($UserObj->id) { +<& /Elements/EditCustomField, %ARGS, Object => $UserObj, CustomField => $CF &> +% } else { +<& /Elements/EditCustomField, %ARGS, NamePrefix => 'Object-RT::User--CustomField-', CustomField => $CF &> +% } +</td></tr> +% } +</table> +</&> +% $m->callback( %ARGS, CallbackName => 'RightColumnBottom', UserObj => $UserObj ); +</td></tr> +<tr> +<td colspan="2"> +<&| /Widgets/TitleBox, title => loc('Comments about this user') &> +<textarea class="comments" name="Comments" cols="80" rows="5" wrap="virtual"><%$UserObj->Comments||$Comments||''%></textarea> +</&> +%if (!$Create && $UserObj->Privileged) { +<br /> +<&| /Widgets/TitleBox, title => loc('Signature') &> +<textarea class="signature" cols="80" rows="5" name="Signature" wrap="hard"><%$UserObj->Signature||$Signature||''%></textarea> +</&> +% } + +</td> +</tr> +</table> + +% if ( $Create ) { +<& /Elements/Submit, Label => loc('Create') &> +% } else { +<& /Elements/Submit, Label => loc('Save Changes') &> +% } +</form> + +<%INIT> + +my $UserObj = RT::User->new($session{'CurrentUser'}); +my ($title, $PrivilegedChecked, $EnabledChecked, $Disabled, $result, @results); + +my ($val, $msg); + +if ($Create) { + $title = loc("Create a new user"); +} +else { + + if ( defined $id && $id eq 'new') { + ( $val, $msg ) = $UserObj->Create( + Name => $Name, + EmailAddress => $ARGS{'EmailAddress'}, + Name => $ARGS{'Name'}, + Comments => $ARGS{'Comments'}, + Signature => $ARGS{'Signature'}, + EmailAddress => $ARGS{'EmailAddress'}, + FreeformContactInfo => $ARGS{'FreeformContactInfo'}, + Organization => $ARGS{'Organization'}, + RealName => $ARGS{'RealName'}, + NickName => $ARGS{'NickName'}, + Lang => $ARGS{'Lang'}, + EmailEncoding => $ARGS{'EmailEncoding'}, + WebEncoding => $ARGS{'WebEncoding'}, + ExternalContactInfoId => $ARGS{'ExternalContactInfoId'}, + ContactInfoSystem => $ARGS{'ContactInfoSystem'}, + Gecos => $ARGS{'Gecos'}, + ExternalAuthId => $ARGS{'ExternalAuthId'}, + AuthSystem => $ARGS{'AuthSystem'}, + HomePhone => $ARGS{'HomePhone'}, + WorkPhone => $ARGS{'WorkPhone'}, + MobilePhone => $ARGS{'MobilePhone'}, + PagerPhone => $ARGS{'PagerPhone'}, + Address1 => $ARGS{'Address1'}, + Address2 => $ARGS{'Address2'}, + City => $ARGS{'City'}, + State => $ARGS{'State'}, + Zip => $ARGS{'Zip'}, + Country => $ARGS{'Country'}, + Privileged => $ARGS{'Privileged'}, + Disabled => ($ARGS{'Enabled'} ? 0 : 1) + ); + + if ($val) { + push @results, $msg; + push @results, ProcessObjectCustomFieldUpdates( ARGSRef => \%ARGS, Object => $UserObj ); + } else { + push @results, loc('User could not be created: [_1]', $msg); + } + } else { + $UserObj->Load($id) || $UserObj->Load($Name) + || Abort("Couldn't load user '" . ( $Name || '') . "'"); + $val = $UserObj->Id(); + } + + if ($val) { + $title = loc("Modify the user [_1]", $UserObj->Name); + } + + # If the create failed + else { + $title = loc("Create a new user"); + $Create = 1; + } +} + + +$m->callback( %ARGS, CallbackName => 'BeforeUpdate', User => $UserObj, ARGSRef => \%ARGS, Results => \@results ); + + +# If we have a user to modify, lets try. +if ($UserObj->Id && $id ne 'new') { + + my @fields = qw(Name Comments Signature EmailAddress FreeformContactInfo + Organization RealName NickName Lang EmailEncoding WebEncoding + ExternalContactInfoId ContactInfoSystem Gecos ExternalAuthId + AuthSystem HomePhone WorkPhone MobilePhone PagerPhone Address1 + Address2 City State Zip Country + ); + + my @fieldresults = UpdateRecordObject ( AttributesRef => \@fields, + Object => $UserObj, + ARGSRef => \%ARGS ); + push (@results,@fieldresults); + push @results, ProcessObjectCustomFieldUpdates( ARGSRef => \%ARGS, Object => $UserObj ); + + #deal with freeside customer links + push @results, ProcessObjectCustomers( ARGSRef => \%ARGS, Object => $UserObj ); + + # {{{ Deal with special fields: Privileged, Enabled + if ( $SetPrivileged and $Privileged != $UserObj->Privileged ) { + my ($code, $msg) = $UserObj->SetPrivileged($Privileged); + push @results, loc('Privileged status: [_1]', loc_fuzzy($msg)); + } + + #we're asking about enabled on the web page but really care about disabled. + $Disabled = $Enabled ? 0 : 1; + + if ( ($SetEnabled) and ( $Disabled != $UserObj->Disabled) ) { + my ($code, $msg) = $UserObj->SetDisabled($Disabled); + push @results, $msg; + } + + +} + + +my %password_cond = $UserObj->CurrentUserRequireToSetPassword; +if ( $UserObj->Id ) { + # Deal with Password field + my ($status, $msg) = $UserObj->SafeSetPassword( + Current => $CurrentPass, + New => $Pass1, + Confirmation => $Pass2, + ); + push @results, $msg; + + if ( $id eq 'new' && !$status ) { + push @results, loc("A password was not set, so user won't be able to login."); + } +} + + +# Do some setup for the ui +unless ( $UserObj->id && $UserObj->Disabled ) { + $EnabledChecked = 'checked="checked"'; +} + +if ((!$Create && $UserObj->Privileged()) or (!$UserObj->Id and $Privileged)) { + $PrivilegedChecked = 'checked="checked"'; +} + +# This code does automatic redirection if any updates happen. +MaybeRedirectForResults( + Actions => \@results, + Arguments => { id => $UserObj->Id }, +) if $UserObj->Id; + +</%INIT> + + +<%ARGS> +$id => undef +$Name => undef +$Comments => undef +$Signature => undef +$EmailAddress => undef +$FreeformContactInfo => undef +$Organization => undef +$RealName => undef +$NickName => undef +$Privileged => undef +$SetPrivileged => undef +$Enabled => undef +$SetEnabled => undef +$Lang => undef +$EmailEncoding => undef +$WebEncoding => undef +$ExternalContactInfoId => undef +$ContactInfoSystem => undef +$Gecos => undef +$ExternalAuthId => undef +$AuthSystem => undef +$HomePhone => undef +$WorkPhone => undef +$MobilePhone => undef +$PagerPhone => undef +$Address1 => undef +$Address2 => undef +$City => undef +$State => undef +$Zip => undef +$Country => undef +$CurrentPass => undef +$Pass1 => undef +$Pass2 => undef +$Create=> undef +$OnlySearchForCustomers => undef +$OnlySearchForServices => undef +$CustomerString => undef +$ServiceString => undef +</%ARGS> diff --git a/rt/share/html/Approvals/index.html b/rt/share/html/Approvals/index.html index 97f360ac0..dbdc11ec5 100755 --- a/rt/share/html/Approvals/index.html +++ b/rt/share/html/Approvals/index.html @@ -72,12 +72,9 @@ foreach my $arg ( keys %ARGS ) { next if $skip_update; if ( $ARGS{ "Approval-" . $ticket->Id . "-Notes" } ) { - my $notes = MIME::Entity->build( - Data => [ $ARGS{ "Approval-" . $ticket->Id . "-Notes" } ] - ); - RT::I18N::SetMIMEEntityToUTF8($notes); # convert text parts into utf-8 - - my ( $notesval, $notesmsg ) = $ticket->Correspond( MIMEObj => $notes ); + my ( $notesval, $notesmsg ) = $ticket->Correspond( + Content => $ARGS{ "Approval-" . $ticket->Id . "-Notes" } + ); if ($notesval) { push ( @actions, loc("Approval #[_1]: Notes recorded",$ticket->Id )); } else { diff --git a/rt/share/html/Elements/.CalendarDaySchedule.swp b/rt/share/html/Elements/.CalendarDaySchedule.swp Binary files differnew file mode 100644 index 000000000..f79cd0938 --- /dev/null +++ b/rt/share/html/Elements/.CalendarDaySchedule.swp diff --git a/rt/share/html/Elements/.CalendarEventWeekly.swp b/rt/share/html/Elements/.CalendarEventWeekly.swp Binary files differnew file mode 100644 index 000000000..af6c22220 --- /dev/null +++ b/rt/share/html/Elements/.CalendarEventWeekly.swp diff --git a/rt/share/html/Elements/.CalendarSlotSchedule.swp b/rt/share/html/Elements/.CalendarSlotSchedule.swp Binary files differnew file mode 100644 index 000000000..6b8a8f9c2 --- /dev/null +++ b/rt/share/html/Elements/.CalendarSlotSchedule.swp diff --git a/rt/share/html/Elements/CalendarSlotSchedule.dynamic b/rt/share/html/Elements/CalendarSlotSchedule.dynamic new file mode 100644 index 000000000..88202d417 --- /dev/null +++ b/rt/share/html/Elements/CalendarSlotSchedule.dynamic @@ -0,0 +1,93 @@ +<%ARGS> + $Date => undef, + @Tickets => () + $slots => $default_slots, + $sday => undef, + $tod_row => undef, + $timestep => $default_timestep, + @username => () +</%ARGS> +<%SHARED> +my @slots = ( [], [], [], [], [], [], [] ); +</%SHARED> +% #for my $t ( @{ $Tickets{$date->strftime("%F")} } ) { +% for my $t (@Tickets) { +% +% my($sm, $sh) = ($t->StartsObj->Localtime('user'))[1,2]; +% my $starts = $sh*60 + $sm; +% +% if ( RTx::Calendar::LocalDate($t->StartsObj->Unix) eq $Date->strftime('%F') #today +% && $starts >= $tod_row && $starts < ($tod_row + $timestep) ) { +% #then we're a new entry, find a slot for us +% my $s = 0; +% while ( ref($slots[$sday]->[$s]) ) { $s++ } +% $slots[$sday]->[$s] = [ $t->Id, $t ]; +% } +% +% my($dm, $dh) = ($t->DueObj->Localtime('user'))[1,2]; +% my $due = $dh*60 + $dm; +% +% if ( RTx::Calendar::LocalDate($t->DueObj->Unix) eq $Date->strftime('%F') #today +% && $due <= $tod_row && $due > ($tod_row + $timestep ) ) { +% #then find our slot and remove us +% @{ $slots[$sday] } = +% map { (!ref($_) || $_->[0] != $t->Id) ? $_ : '' } +% @{ $slots[$sday] }; +% } +% +% } +% +% pop @{ $slots[$sday] } while @{ $slots[$sday] } && !ref($slots[$sday]->[-1]); +% +% #now display: +% +% if ( scalar(@{$slots[$sday]}) > $slots ) { +% #overflow situation, eek... could be handled better, how? + + <td colspan=<%$slots%> + class="weekly +%# <% $is_today ? 'today' +%# : $is_yesterday ? 'yesterday' +%# : $is_aweekago ? 'aweekago' +%# : '' +%# %> + " + >MULTIPLE + </td> + +% } else { +% +% foreach my $slot ( @{ $slots[$sday] } ) { +% my( $id, $ticket ) = @$slot; + + <td class="weekly +%# <% $is_today ? 'today' +%# : $is_yesterday ? 'yesterday' +%# : $is_aweekago ? 'aweekago' +%# : '' +%# %> + " + ><% $id %> + </td> + +% } +% +% if ( scalar(@{$slots[$sday]}) < $slots ) { + + <td colspan=<% $slots - scalar(@{$slots[$sday]}) %> + class="weekly +%# <% $is_today ? 'today' +%# : $is_yesterday ? 'yesterday' +%# : $is_aweekago ? 'aweekago' +%# : '' +%# %> + " + > + </td> +% } +% +% } +<%ONCE> +my $default_slots = RT->Config->Get('CalendarWeeklySlots') || 5; +my $default_timestep = RT->Config->Get('CalendarWeeklySizeMin') || 30; #1/2h +</%ONCE> diff --git a/rt/share/html/Elements/EditCustomFieldDate b/rt/share/html/Elements/EditCustomFieldDate index f62f04704..c430b0b33 100644 --- a/rt/share/html/Elements/EditCustomFieldDate +++ b/rt/share/html/Elements/EditCustomFieldDate @@ -46,7 +46,7 @@ %# %# END BPS TAGGED BLOCK }}} % my $name = $NamePrefix.$CustomField->Id.'-Values'; -<& /Elements/SelectDate, Name => "$name", current => 0, ShowTime => 0 &> (<%$DateObj->AsString(Time => 0, Timezone => 'utc')%>) +<& /Elements/SelectDate, Name => "$name", current => 0, ShowTime => 0, $KeepValue && $Default ? (Default => $Default) : () &> (<%$DateObj->AsString(Time => 0, Timezone => 'utc')%>) <%INIT> my $DateObj = RT::Date->new ( $session{'CurrentUser'} ); @@ -59,4 +59,5 @@ $NamePrefix => undef $Default => undef $Values => undef $MaxValues => 1 +$KeepValue => undef </%ARGS> diff --git a/rt/share/html/Elements/EditCustomFieldDateTime b/rt/share/html/Elements/EditCustomFieldDateTime index edf125e80..b50ea431a 100644 --- a/rt/share/html/Elements/EditCustomFieldDateTime +++ b/rt/share/html/Elements/EditCustomFieldDateTime @@ -46,7 +46,7 @@ %# %# END BPS TAGGED BLOCK }}} % my $name = $NamePrefix.$CustomField->Id.'-Values'; -<& /Elements/SelectDate, Name => "$name", current => 0 &> (<%$DateObj->AsString%>) +<& /Elements/SelectDate, Name => "$name", current => 0, $KeepValue && $Default ? (Default => $Default) : () &> (<%$DateObj->AsString($KeepValue ? ( Timezone => 'utc' ) : () )%>) <%INIT> my $DateObj = RT::Date->new ( $session{'CurrentUser'} ); @@ -60,4 +60,5 @@ $Default => undef $Values => undef $MaxValues => 1 $Format => 'ISO' +$KeepValue => undef </%ARGS> diff --git a/rt/share/html/Elements/Error b/rt/share/html/Elements/Error index b2042610e..d747c4e5b 100755 --- a/rt/share/html/Elements/Error +++ b/rt/share/html/Elements/Error @@ -78,11 +78,7 @@ $SuppressHeader => 0, my $error = "WebRT: $Why"; $error .= " ($Details)" if defined $Details && length $Details; -# TODO: Log::Dispatch isn't UTF-8 safe. Autrijus needs to talk to dave rolsky about getting this fixed -use Encode (); -Encode::_utf8_off($error); - -$RT::Logger->error($error); +$RT::Logger->error( $error ); if ( $session{'REST'} ) { $r->content_type('text/plain'); diff --git a/rt/share/html/NoAuth/css/.calendar.css.swp b/rt/share/html/NoAuth/css/.calendar.css.swp Binary files differnew file mode 100644 index 000000000..cbc46cd5e --- /dev/null +++ b/rt/share/html/NoAuth/css/.calendar.css.swp diff --git a/rt/share/html/NoAuth/css/aileron/ticket.css b/rt/share/html/NoAuth/css/aileron/ticket.css index 0d60f6ada..bc6315001 100644 --- a/rt/share/html/NoAuth/css/aileron/ticket.css +++ b/rt/share/html/NoAuth/css/aileron/ticket.css @@ -223,22 +223,6 @@ div#ticket-history .messagebody .messagebody{ .ticket-summary .titlebox-title .left a, .ticket-summary .titlebox-title .left a:visited { color: #fff;} -.unread-messages .titlebox , .unread-messages .titlebox-title .left { - border: 1px solid #99a; - border-right: 2px solid #aab; - border-bottom: 2px solid #aab; - -} - - -.unread-messages .titlebox { - background-color: #dde; -} - -.unread-messages .titlebox-title .left { - background-color: #cce; -} - .ticket-inactive { text-decoration: line-through; color: #666 diff --git a/rt/share/html/NoAuth/css/base/ticket.css b/rt/share/html/NoAuth/css/base/ticket.css index 6a43a1db1..d30b04645 100644 --- a/rt/share/html/NoAuth/css/base/ticket.css +++ b/rt/share/html/NoAuth/css/base/ticket.css @@ -143,4 +143,7 @@ display: none; } +.unread-messages .titlebox-content :link { + text-decoration: underline; +} diff --git a/rt/share/html/NoAuth/iCal/dhandler b/rt/share/html/NoAuth/iCal/dhandler index 35da94080..46c272921 100644 --- a/rt/share/html/NoAuth/iCal/dhandler +++ b/rt/share/html/NoAuth/iCal/dhandler @@ -48,7 +48,6 @@ <%init> use Data::ICal; use Data::ICal::Entry::Event; -use Encode (); my $path = $m->dhandler_arg; @@ -62,8 +61,8 @@ $notfound->() unless $path =~ m!^([^/]+)/([^/]+)/(.*)(\.(ical|ics))?!; my ($name, $auth, $search) = ($1, $2, $3); # Unescape parts $_ =~ s/\%([0-9a-z]{2})/chr(hex($1))/gei for $name, $search; -# convert to perl strings -$_ = Encode::decode_utf8( $_ ) for $name, $search; +# Decode from bytes to characters +$_ = Encode::decode( "UTF-8", $_ ) for $name, $search; my $user = RT::User->new( RT->SystemUser ); $user->Load( $name ); diff --git a/rt/share/html/NoAuth/images/week-collapse.xcf b/rt/share/html/NoAuth/images/week-collapse.xcf Binary files differnew file mode 100644 index 000000000..cbb2b95eb --- /dev/null +++ b/rt/share/html/NoAuth/images/week-collapse.xcf diff --git a/rt/share/html/NoAuth/images/week-expand.xcf b/rt/share/html/NoAuth/images/week-expand.xcf Binary files differnew file mode 100644 index 000000000..1ab8e65c8 --- /dev/null +++ b/rt/share/html/NoAuth/images/week-expand.xcf diff --git a/rt/share/html/REST/1.0/Forms/ticket/comment b/rt/share/html/REST/1.0/Forms/ticket/comment index 934cbfb68..41320ba4c 100755 --- a/rt/share/html/REST/1.0/Forms/ticket/comment +++ b/rt/share/html/REST/1.0/Forms/ticket/comment @@ -91,8 +91,9 @@ my $ent = MIME::Entity->build( 'X-RT-Interface' => 'REST', ); $ent->attach( - 'Content-Type' => $changes{'Content-Type'} || 'text/plain', - Data => $changes{Text}, + Type => $changes{'Content-Type'} || 'text/plain', + Charset => "UTF-8", + Data => Encode::encode("UTF-8", $changes{Text} ), ) if $changes{Text}; diff --git a/rt/share/html/REST/1.0/Forms/ticket/default b/rt/share/html/REST/1.0/Forms/ticket/default index 2a0c7efa4..33a8935d6 100755 --- a/rt/share/html/REST/1.0/Forms/ticket/default +++ b/rt/share/html/REST/1.0/Forms/ticket/default @@ -191,13 +191,14 @@ else { $v{MIMEObj} = MIME::Entity->build( Type => "multipart/mixed", - From => $session{CurrentUser}->EmailAddress, - Subject => $v{Subject}, + From => Encode::encode( "UTF-8", $session{CurrentUser}->EmailAddress ), + Subject => Encode::encode( "UTF-8", $v{Subject}), 'X-RT-Interface' => 'REST', ); $v{MIMEObj}->attach( - Data => $text, - 'Content-Type' => $v{'Content-Type'} || 'text/plain', + Type => $v{'Content-Type'} || 'text/plain', + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $text ), ) if $text; my ($status, $msg) = process_attachments($v{'MIMEObj'}, @atts); unless ($status) { diff --git a/rt/share/html/REST/1.0/ticket/comment b/rt/share/html/REST/1.0/ticket/comment index 4c058b6ab..177690d6a 100755 --- a/rt/share/html/REST/1.0/ticket/comment +++ b/rt/share/html/REST/1.0/ticket/comment @@ -108,7 +108,11 @@ my $ent = MIME::Entity->build( Type => "multipart/mixed", 'X-RT-Interface' => 'REST', ); -$ent->attach(Data => $k->{Text}) if $k->{Text}; +$ent->attach( + Type => "text/plain", + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $k->{Text} ), +) if $k->{Text}; { my ($res, $msg) = process_attachments($ent, @atts); diff --git a/rt/share/html/Schedule/.UserBar.swp b/rt/share/html/Schedule/.UserBar.swp Binary files differnew file mode 100644 index 000000000..0dcd4315e --- /dev/null +++ b/rt/share/html/Schedule/.UserBar.swp diff --git a/rt/share/html/Search/.Calendar.html.swp b/rt/share/html/Search/.Calendar.html.swp Binary files differnew file mode 100644 index 000000000..3e3788220 --- /dev/null +++ b/rt/share/html/Search/.Calendar.html.swp diff --git a/rt/share/html/Search/.Schedule.html.swp b/rt/share/html/Search/.Schedule.html.swp Binary files differnew file mode 100644 index 000000000..e88b29135 --- /dev/null +++ b/rt/share/html/Search/.Schedule.html.swp diff --git a/rt/share/html/Search/Bulk.html.orig b/rt/share/html/Search/Bulk.html.orig new file mode 100755 index 000000000..38ca64248 --- /dev/null +++ b/rt/share/html/Search/Bulk.html.orig @@ -0,0 +1,460 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +%# <sales@bestpractical.com> +%# +%# (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 }}} +<& /Elements/Header, Title => $title &> +<& /Elements/Tabs &> + +<& /Elements/ListActions, actions => \@results &> +<form method="post" action="<% RT->Config->Get('WebPath') %>/Search/Bulk.html" enctype="multipart/form-data" name="BulkUpdate" id="BulkUpdate"> +% foreach my $var (qw(Query Format OrderBy Order Rows Page SavedChartSearchId)) { +<input type="hidden" class="hidden" name="<%$var%>" value="<%$ARGS{$var} || ''%>" /> +%} +<& /Elements/CollectionList, + Query => $Query, + DisplayFormat => $Format, + Format => $ARGS{'Format'}, + Verbatim => 1, + AllowSorting => 1, + OrderBy => $OrderBy, + Order => $Order, + Rows => $Rows, + Page => $Page, + BaseURL => RT->Config->Get('WebPath')."/Search/Bulk.html?", + Class => 'RT::Tickets' + &> + +% $m->callback(CallbackName => 'AfterTicketList', ARGSRef => \%ARGS); + +<hr /> + +<& /Elements/Submit, Label => loc('Update'), CheckboxNameRegex => '/^UpdateTicket\d+$/', CheckAll => 1, ClearAll => 1 &> +<br /> +<&|/Widgets/TitleBox, title => $title &> +<table> +<tr> +<td valign="top"> +<table> +<tr><td class="label"> <&|/l&>Make Owner</&>: </td> +<td class="value"> <& /Elements/SelectOwner, Name => "Owner", Default => $ARGS{Owner} || '' &> +(<input type="checkbox" class="checkbox" name="ForceOwnerChange" + <% $ARGS{ForceOwnerChange} ? 'checked="checked"' : '' %> /> <&|/l&>Force change</&>) </td></tr> +<tr><td class="label"> <&|/l&>Add Requestor</&>: </td> +<td class="value"> <input name="AddRequestor" size="20" value="<% $ARGS{AddRequestor} || '' %>" /> </td></tr> +<tr><td class="label"> <&|/l&>Remove Requestor</&>: </td> +<td class="value"> <input name="DeleteRequestor" size="20" value="<% $ARGS{DeleteRequestor} || '' %>"/> </td></tr> +<tr><td class="label"> <&|/l&>Add Cc</&>: </td> +<td class="value"> <input name="AddCc" size="20" value="<% $ARGS{AddCc} || '' %>" /> </td></tr> +<tr><td class="label"> <&|/l&>Remove Cc</&>: </td> +<td class="value"> <input name="DeleteCc" size="20" value="<% $ARGS{DeleteCc} || '' %>" /> </td></tr> +<tr><td class="label"> <&|/l&>Add AdminCc</&>: </td> +<td class="value"> <input name="AddAdminCc" size="20" value="<% $ARGS{AddAdminCc} || '' %>" /> </td></tr> +<tr><td class="label"> <&|/l&>Remove AdminCc</&>: </td> +<td class="value"> <input name="DeleteAdminCc" size="20" value="<% $ARGS{DeleteAdminCc} || '' %>" /> </td></tr> +</table> +</td> +<td valign="top"> +<table> +<tr><td class="label"> <&|/l&>Make subject</&>: </td> +<td class="value"> <input name="Subject" size="20" value="<% $ARGS{Subject} || '' %>"/> </td></tr> +<tr><td class="label"> <&|/l&>Make priority</&>: </td> +% my $rel = ($ARGS{Priority} =~ s/^R//); +<td class="value"> <& /Elements/SelectPriority, Name => "Priority", Default => $ARGS{Priority} &> +<select name="Priority-Mode"> +<option value="absolute" <% !$rel && 'selected' %>>absolute</option> +<option value="relative" <% $rel && 'selected' %>>relative</option> +</select> +</td></tr> +<tr><td class="label"> <&|/l&>Make queue</&>: </td> +<td class="value"> <& /Elements/SelectQueue, Name => "Queue", Default => $ARGS{Queue} &> </td></tr> +<tr><td class="label"> <&|/l&>Make Status</&>: </td> +<td class="value"> <& /Elements/SelectStatus, Name => "Status", Default => $ARGS{Status}, Queues => $seen_queues &> </td></tr> +<tr><td class="label"> <&|/l&>Make date Starts</&>: </td> +<td class="value"> <& /Elements/SelectDate, Name => "Starts_Date", Default => $ARGS{Starts_Date} || '' &> </td></tr> +<tr><td class="label"> <&|/l&>Make date Started</&>: </td> +<td class="value"> <& /Elements/SelectDate, Name => "Started_Date", Default => $ARGS{Started_Date} || '' &> </td></tr> +<tr><td class="label"> <&|/l&>Make date Told</&>: </td> +<td class="value"> <& /Elements/SelectDate, Name => "Told_Date", Default => $ARGS{Told_Date} || '' &> </td></tr> +<tr><td class="label"> <&|/l&>Make date Due</&>: </td> +<td class="value"> <& /Elements/SelectDate, Name => "Due_Date", Default => $ARGS{Due_Date} || '' &> </td></tr> +<tr><td class="label"> <&|/l&>Make date Resolved</&>: </td> +<td class="value"> <& /Elements/SelectDate, Name => "Resolved_Date", Default => $ARGS{Resolved_Date} || '' &> </td></tr> +</table> + +</td> +</tr> +</table> +</&> +<&| /Widgets/TitleBox, title => loc('Add comments or replies to selected tickets') &> +<table> +<tr><td align="right"><&|/l&>Update Type</&>:</td> +<td><select name="UpdateType"> + <option value="private" <% $ARGS{UpdateType} && $ARGS{UpdateType} eq 'private' ? 'selected="selected"' : '' %> ><&|/l&>Comments (Not sent to requestors)</&></option> +<option value="response" <% $ARGS{UpdateType} && $ARGS{UpdateType} eq 'response' ? 'selected="selected"' : '' %>><&|/l&>Reply to requestors</&></option> +</select> +</td></tr> +<tr><td align="right"><&|/l&>Subject</&>:</td><td> <input name="UpdateSubject" +size="60" value="<% $ARGS{UpdateSubject} || "" %>" /></td></tr> +% while (my $CF = $TxnCFs->Next()) { +<tr> +<td align="right"><% $CF->Name %>:</td> +<td><& /Elements/EditCustomField, + CustomField => $CF, + NamePrefix => "Object-RT::Transaction--CustomField-", + Default => $ARGS{"Object-RT::Transaction--CustomField-" . $CF->id . '-Values'} || + $ARGS{"Object-RT::Transaction--CustomField-" . $CF->id . '-Value'}, + &><em><% $CF->FriendlyType %></em></td> +</td></tr> +% } # end if while + +<& /Ticket/Elements/AddAttachments, %ARGS &> + + <tr><td class="labeltop"><&|/l&>Message</&>:</td><td> +%# Currently, bulk update always starts with Comment not Reply selected, so we check this unconditionally +% my $IncludeSignature = RT->Config->Get('MessageBoxIncludeSignatureOnComment'); +<& /Elements/MessageBox, Name => "UpdateContent", + $ARGS{UpdateContent} ? ( Default => $ARGS{UpdateContent}, IncludeSignature => 0 ) : + ( IncludeSignature => $IncludeSignature ), + &> + </td></tr> + </table> + +</&> + +<%perl> +my $cfs = RT::CustomFields->new($session{'CurrentUser'}); +$cfs->LimitToGlobal(); +$cfs->LimitToQueue($_) for keys %$seen_queues; +</%perl> + +% if ($cfs->Count) { +<&|/Widgets/TitleBox, title => loc('Edit Custom Fields'), color => "#336633"&> +<table> +<tr> +<th><&|/l&>Name</&></th> +<th><&|/l&>Add values</&></th> +<th><&|/l&>Delete values</&></th> +</tr> +% while (my $cf = $cfs->Next()) { +<tr> +<td class="label"><% loc($cf->Name) %><br /> +<em>(<%$cf->FriendlyType%>)</em></td> +% my $rows = 5; +% my $cf_id = $cf->id; +% my @add = (NamePrefix => 'Bulk-Add-CustomField-', CustomField => $cf, Rows => $rows, +% Multiple => ($cf->MaxValues ==1 ? 0 : 1) , Cols => 25, +% Default => $ARGS{"Bulk-Add-CustomField-$cf_id-Values"} || $ARGS{"Bulk-Add-CustomField-$cf_id-Value"}, ); +% my @del = (NamePrefix => 'Bulk-Delete-CustomField-', CustomField => $cf, +% Rows => $rows, Multiple => 1, Cols => 25, +% Default => $ARGS{"Bulk-Delete-CustomField-$cf_id-Values"} || $ARGS{"Bulk-Delete-CustomField-$cf_id-Value"}, ); +% if ($cf->Type eq 'Select') { +<td><& /Elements/EditCustomFieldSelect, @add &></td> +<td><& /Elements/EditCustomFieldSelect, @del &></td> +% } elsif ($cf->Type eq 'Combobox') { +<td><& /Elements/EditCustomFieldCombobox, @add &></td> +<td><& /Elements/EditCustomFieldCombobox, @del &></td> +% } elsif ($cf->Type eq 'Freeform') { +<td><& /Elements/EditCustomFieldFreeform, @add &></td> +<td><& /Elements/EditCustomFieldFreeform, @del &></td> +% } elsif ($cf->Type eq 'Text') { +<td><& /Elements/EditCustomFieldText, @add &></td> +<td> </td> +% } elsif ($cf->Type eq 'Date') { +<td><& /Elements/EditCustomFieldDate, @add, Default => undef &></td> +<td><& /Elements/EditCustomFieldDate, @del, Default => undef &></td> +% } elsif ($cf->Type eq 'DateTime') { +% # Pass datemanip format to prevent another tz date conversion +<td><& /Elements/EditCustomFieldDateTime, @add, Default => undef, Format => 'datemanip' &></td> +<td><& /Elements/EditCustomFieldDateTime, @del, Default => undef, Format => 'datemanip' &></td> +% } else { +% $RT::Logger->crit("Unknown CustomField type: " . $cf->Type); +% } +</tr> +% } +</table> +</&> +% } + +<&|/Widgets/TitleBox, title => loc('Edit Links'), color => "#336633"&> +<em><&|/l&>Enter tickets or URIs to link tickets to. Separate multiple entries with spaces.</&></em><br /> +<& /Ticket/Elements/BulkLinks, Tickets => $Tickets, $ARGS{'AddMoreAttach'} ? %ARGS : () &> +</&> + +<& /Elements/Submit, Label => loc('Update') &> + + +</form> + + +<%INIT> +unless ( defined $Rows ) { + $Rows = $RowsPerPage; + $ARGS{Rows} = $RowsPerPage; +} +my $title = loc("Update multiple tickets"); + +# Iterate through the ARGS hash and remove anything with a null value. +map ( $ARGS{$_} =~ /^$/ && ( delete $ARGS{$_} ), keys %ARGS ); + +my (@results); + +ProcessAttachments(ARGSRef => \%ARGS); + +$Page ||= 1; + +$Format ||= RT->Config->Get('DefaultSearchResultFormat'); + +# inject _CHECKBOX to the first field. +$Format =~ s/'?([^']+)'?,/'___CHECKBOX__$1',/; #' + +my $Tickets = RT::Tickets->new( $session{'CurrentUser'} ); +$Tickets->FromSQL($Query); +if ( $OrderBy =~ /\|/ ) { + + # Multiple Sorts + my @OrderBy = split /\|/, $OrderBy; + my @Order = split /\|/, $Order; + $Tickets->OrderByCols( + map { { FIELD => $OrderBy[$_], ORDER => $Order[$_] } } + ( 0 .. $#OrderBy ) ); +} +else { + $Tickets->OrderBy( FIELD => $OrderBy, ORDER => $Order ); +} + +$Tickets->RowsPerPage($Rows) if ($Rows); +$Tickets->GotoPage( $Page - 1 ); # SB uses page 0 as the first page + +Abort( loc("No search to operate on.") ) unless ($Tickets); + +# build up a list of all custom fields for tickets that we're displaying, so +# we can display sane edit widgets. + +my $fields = {}; +my $seen_queues = {}; +while ( my $ticket = $Tickets->Next ) { + next if $seen_queues->{ $ticket->Queue }++; + + my $custom_fields = $ticket->CustomFields; + while ( my $field = $custom_fields->Next ) { + $fields->{ $field->id } = $field; + } +} + +#Iterate through each ticket we've been handed +my @linkresults; + +$Tickets->RedoSearch(); + +# pull out the labels for any custom fields we want to update + +my $cf_del_keys; +@$cf_del_keys = grep { /^Bulk-Delete-CustomField/ } keys %ARGS; +my $cf_add_keys; +@$cf_add_keys = grep { /^Bulk-Add-CustomField/ } keys %ARGS; + +if ( defined($ARGS{'Priority'}) + and ($ARGS{'Priority-Mode'} || '') eq 'relative' ) { + # magic in Ticket::SetPriority + $ARGS{'Priority'} = 'R'.$ARGS{'Priority'}; +} +delete $ARGS{'Priority-Mode'}; + +unless ( $ARGS{'AddMoreAttach'} ) { + # Add session attachments if any to be processed by ProcessUpdateMessage + $ARGS{'UpdateAttachments'} = $session{'Attachments'} if ( $session{'Attachments'} ); + + while ( my $Ticket = $Tickets->Next ) { + next unless ( $ARGS{ "UpdateTicket" . $Ticket->Id } ); + + #Update the links + $ARGS{'id'} = $Ticket->id; + + my @updateresults = ProcessUpdateMessage( + TicketObj => $Ticket, + ARGSRef => \%ARGS, + ); + + #Update the basics. + my @basicresults = + ProcessTicketBasics( TicketObj => $Ticket, ARGSRef => \%ARGS ); + my @dateresults = + ProcessTicketDates( TicketObj => $Ticket, ARGSRef => \%ARGS ); + + #Update the watchers + my @watchresults = + ProcessTicketWatchers( TicketObj => $Ticket, ARGSRef => \%ARGS ); + + foreach my $type (qw(MergeInto DependsOn MemberOf RefersTo)) { + $ARGS{ $Ticket->id . "-" . $type } = $ARGS{"Ticket-$type"}; + $ARGS{ $type . "-" . $Ticket->id } = $ARGS{"$type-Ticket"}; + } + @linkresults = + ProcessTicketLinks( TicketObj => $Ticket, ARGSRef => \%ARGS ); + foreach my $type (qw(MergeInto DependsOn MemberOf RefersTo)) { + delete $ARGS{ $type . "-" . $Ticket->id }; + delete $ARGS{ $Ticket->id . "-" . $type }; + } + + my @cfresults; + + foreach my $list ( $cf_add_keys, $cf_del_keys ) { + next unless $list->[0]; + + + my $op; + if ( $list->[0] =~ /Add/ ) { + $op = 'add'; + + } + elsif ( $list->[0] =~ /Del/ ) { + $op = 'del'; + } + else { + $RT::Logger->crit( + "Got an op that was neither add nor delete. can never happen" + . $list->[0] ); + last; + } + + foreach my $key (@$list) { + my ( $cfid, $cf ); + next if $key =~ /CustomField-(\d+)-Category$/; + if ( $key =~ /CustomField-(\d+)-/ ) { + $cfid = $1; + $cf = RT::CustomField->new( $session{'CurrentUser'} ); + $cf->Load($cfid); + } + else {next} + my @values = + ref( $ARGS{$key} ) eq 'ARRAY' + ? @{ $ARGS{$key} } + : ( $ARGS{$key} ); + map { s/(\r\n|\r)/\n/g; } @values; # fix the newlines + # now break the multiline values into multivalues + @values = map { split( /\n/, $_ ) } @values + unless ( $cf->SingleValue ); + + my $current_values = $Ticket->CustomFieldValues($cfid); + + if ( $cf->Type eq 'DateTime' || $cf->Type eq 'Date' ){ + # Clear out empty string submissions to avoid + # Not set changed to Not set + @values = grep length, @values; + } + + foreach my $value (@values) { + + # Convert for timezone. Without converstion, + # HasEntry and DeleteCustomFieldValue fail because + # the value in the DB is converted. + if ( $op eq 'del' + && ($cf->Type eq 'DateTime' || $cf->Type eq 'Date') ){ + my $DateObj = RT::Date->new( $session{'CurrentUser'} ); + $DateObj->Set( Format => 'unknown', + Value => $value ); + $value = $cf->Type eq 'DateTime' ? $DateObj->ISO + : $DateObj->ISO(Time => 0, Seconds => 0); + } + + if ( $op eq 'del' && $current_values->HasEntry($value) ) { + my ( $id, $msg ) = $Ticket->DeleteCustomFieldValue( + Field => $cfid, + Value => $value + ); + push @cfresults, $msg; + } + + elsif ( $op eq 'add' && !$current_values->HasEntry($value) ) { + my ( $id, $msg ) = $Ticket->AddCustomFieldValue( + Field => $cfid, + Value => $value + ); + push @cfresults, $msg; + } + } + } + } + my @statusresults = + ProcessTicketStatus( TicketObj => $Ticket, ARGSRef => \%ARGS ); + + my @tempresults = ( + @watchresults, @basicresults, @dateresults, + @updateresults, @linkresults, @cfresults, + @statusresults + ); + + @tempresults = + map { + $_ =~ /^Ticket \d+:/ ? $_ : + loc( "Ticket [_1]: [_2]", $Ticket->Id, $_ ) + } @tempresults; + + @results = ( @results, @tempresults ); + } + + # Cleanup WebUI + delete $session{'Attachments'}; + + $Tickets->RedoSearch(); +} + +my $TxnCFs = RT::CustomFields->new( $session{CurrentUser} ); +$TxnCFs->LimitToLookupType( RT::Transaction->CustomFieldLookupType ); +$TxnCFs->LimitToGlobalOrObjectId( keys %$seen_queues ); + +</%INIT> +<%args> +$Format => undef +$Page => 1 +$Rows => undef +$RowsPerPage => undef +$Order => 'ASC' +$OrderBy => 'id' +$Query => undef +$SavedSearchId => undef +$SavedChartSearchId => undef +</%args> diff --git a/rt/share/html/Search/Elements/ResultsRSSView b/rt/share/html/Search/Elements/ResultsRSSView index d08771124..a453a8603 100644 --- a/rt/share/html/Search/Elements/ResultsRSSView +++ b/rt/share/html/Search/Elements/ResultsRSSView @@ -46,8 +46,6 @@ %# %# END BPS TAGGED BLOCK }}} <%INIT> -use Encode (); - my $old_current_user; if ( $m->request_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) { @@ -67,8 +65,8 @@ if ( $m->request_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) { # Unescape parts $name =~ s/\%([0-9a-z]{2})/chr(hex($1))/gei; - # convert to perl strings - $name = Encode::decode_utf8($name); + # Decode from bytes to characters + $name = Encode::decode( "UTF-8", $name ); my $user = RT::User->new(RT->SystemUser); $user->Load($name); diff --git a/rt/share/html/Search/Results.tsv b/rt/share/html/Search/Results.tsv index 6d8253e78..376db0ed4 100644 --- a/rt/share/html/Search/Results.tsv +++ b/rt/share/html/Search/Results.tsv @@ -71,7 +71,7 @@ my $col_entry = sub { delete $col->{title} if $col->{title} and $col->{title} =~ /^\s*#\s*$/; return { - header => Encode::encode_utf8(loc($col->{title} || $col->{attribute})), + header => loc($col->{title} || $col->{attribute}), map => $m->comp( "/Elements/ColumnMap", Name => $col->{attribute}, @@ -128,7 +128,7 @@ while (my $row = $Tickets->Next) { # remove tabs from all field values, they screw up the tsv $val = '' unless defined $val; $val =~ s/(?:\n|\r)//g; $val =~ s{\t}{ }g; - Encode::encode_utf8($val); + $val; } @$col)."\n"); } } diff --git a/rt/share/html/Search/Results.tsv.orig b/rt/share/html/Search/Results.tsv.orig new file mode 100644 index 000000000..6d8253e78 --- /dev/null +++ b/rt/share/html/Search/Results.tsv.orig @@ -0,0 +1,137 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +%# <sales@bestpractical.com> +%# +%# (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 }}} +<%ARGS> +$Format => undef +$Query => '' +$OrderBy => 'id' +$Order => 'ASC' +$PreserveNewLines => 0 +</%ARGS> +<%INIT> + +$r->content_type('text/tab-separated-values'); +$r->header_out('Content-Disposition' => 'attachment;filename="Results.tsv"'); + +my $DisplayFormat = $m->comp('/Elements/ScrubHTML', Content => $Format); + +my @Format = $m->comp('/Elements/CollectionAsTable/ParseFormat', Format => $DisplayFormat); + +my @columns; + +my $should_loc = { map { $_ => 1 } qw(Status) }; + +my $col_entry = sub { + my $col = shift; + # in tsv output, "#" is often a comment character but we use it for "id" + delete $col->{title} + if $col->{title} and $col->{title} =~ /^\s*#\s*$/; + return { + header => Encode::encode_utf8(loc($col->{title} || $col->{attribute})), + map => $m->comp( + "/Elements/ColumnMap", + Name => $col->{attribute}, + Attr => 'value' + ), + should_loc => $should_loc->{$col->{attribute}}, + } +}; + +if ($PreserveNewLines) { + my $col = []; + push @columns, $col; + for (@Format) { + if ($_->{title} eq 'NEWLINE') { + $col = []; + push @columns, $col; + } + else { + push @$col, $col_entry->($_); + } + } +} +else { + push @columns, [map { $_->{attribute} + ? $col_entry->($_) + : () } @Format]; +} + +for (@columns) { + $m->out(join("\t", map { $_->{header} } @$_)."\n"); +} + +my $Tickets = RT::Tickets->new( $session{'CurrentUser'} ); +$Tickets->FromSQL( $Query ); +if ( $OrderBy =~ /\|/ ) { + # Multiple Sorts + my @OrderBy = split /\|/, $OrderBy; + my @Order = split /\|/, $Order; + $Tickets->OrderByCols( + map { { FIELD => $OrderBy[$_], ORDER => $Order[$_] } } + ( 0 .. $#OrderBy ) + ); +} +else { + $Tickets->OrderBy( FIELD => $OrderBy, ORDER => $Order ); +} + +my $ii = 0; +while (my $row = $Tickets->Next) { + for my $col (@columns) { + $m->out(join("\t", map { + my $val = ProcessColumnMapValue($_->{map}, Arguments => [$row, $ii++], Escape => 0); + $val = loc($val) if $_->{should_loc}; + # remove tabs from all field values, they screw up the tsv + $val = '' unless defined $val; + $val =~ s/(?:\n|\r)//g; $val =~ s{\t}{ }g; + Encode::encode_utf8($val); + } @$col)."\n"); + } +} +$m->abort(); + +</%INIT> diff --git a/rt/share/html/Ticket/Create.html b/rt/share/html/Ticket/Create.html index 697db546b..bd60b5c98 100755 --- a/rt/share/html/Ticket/Create.html +++ b/rt/share/html/Ticket/Create.html @@ -105,8 +105,8 @@ % $m->callback( CallbackName => 'AfterOwner', ARGSRef => \%ARGS ); - <& /Ticket/Elements/EditCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1 &> - <& /Ticket/Elements/EditTransactionCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1 &> + <& /Ticket/Elements/EditCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1, KeepValue => 1 &> + <& /Ticket/Elements/EditTransactionCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1, KeepValue => 1 &> </table> </&> % $m->callback( CallbackName => 'AfterBasics', QueueObj => $QueueObj, ARGSRef => \%ARGS ); diff --git a/rt/share/html/Ticket/Create.html.orig b/rt/share/html/Ticket/Create.html.orig new file mode 100755 index 000000000..697db546b --- /dev/null +++ b/rt/share/html/Ticket/Create.html.orig @@ -0,0 +1,463 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +%# <sales@bestpractical.com> +%# +%# (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 }}} +<& /Elements/Header, + Title => $title, + onload => "function () { hide('Ticket-Create-details') }" &> +<& /Elements/Tabs &> + +<& /Elements/ListActions, actions => \@results &> + +<form action="<% RT->Config->Get('WebPath') %>/Ticket/Create.html" method="post" enctype="multipart/form-data" name="TicketCreate"> + <input type="hidden" class="hidden" name="id" value="new" /> + +% $m->callback( CallbackName => 'FormStart', QueueObj => $QueueObj, ARGSRef => \%ARGS ); + +% if ($gnupg_widget) { + <& /Elements/GnuPG/SignEncryptWidget:ShowIssues, self => $gnupg_widget &> +% } + +<div id="Ticket-Create-basics"> +<a name="basics"></a> + +<div id="ticket-create-metadata"> + <&| /Widgets/TitleBox, title => loc("Basics"), class=>'ticket-info-basics' &> + <table width="100%" border="0"> + <& /Ticket/Elements/EditBasics, + InTable => 1, + fields => [ + { name => 'Queue', + comp => '/Elements/SelectQueue', + args => { + Name => 'Queue', + Default => $QueueObj->Name, + QueueObj => $QueueObj, + ShowNullOption => 0, + ShowAllQueues => 0, + OnChange => "document.getElementsByName('id')[0].value = 'refresh'; form.submit()", + }, + }, + { name => 'Status', + comp => '/Elements/SelectStatus', + args => { + Name => "Status", + Default => $ARGS{Status} || $QueueObj->Lifecycle->DefaultOnCreate, + DefaultValue => 0, + SkipDeleted => 1, + QueueObj => $QueueObj, + }, + }, + { name => 'Owner', + comp => '/Elements/SelectOwner', + args => { + Name => "Owner", + Default => $ARGS{Owner} || RT->Nobody->Id, + DefaultValue => 0, + QueueObj => $QueueObj, + }, + } + ] + &> + +% $m->callback( CallbackName => 'AfterOwner', ARGSRef => \%ARGS ); + + <& /Ticket/Elements/EditCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1 &> + <& /Ticket/Elements/EditTransactionCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1 &> + </table> + </&> +% $m->callback( CallbackName => 'AfterBasics', QueueObj => $QueueObj, ARGSRef => \%ARGS ); +</div> + +<div id="ticket-create-message"> + <&| /Widgets/TitleBox, title => $title, class => 'messagedetails' &> +<table border="0" cellpadding="0" cellspacing="0"> +<tr> +<td class="label"> +<&|/l&>Requestors</&>: +</td> +<td class="value" colspan="5"> +<& /Elements/EmailInput, Name => 'Requestors', Size => undef, Default => exists($ARGS{Requestors}) ? $ARGS{Requestors} : $session{CurrentUser}->EmailAddress &> +% $m->callback( CallbackName => 'AfterRequestors', QueueObj => $QueueObj, ARGSRef => \%ARGS ); +</td> +</tr> +<tr> +<td class="label"> +<&|/l&>Cc</&>: +</td> +<td class="value" colspan="5"><& /Elements/EmailInput, Name => 'Cc', Size => undef, Default => $ARGS{Cc} &></td> +</tr> + +<tr> + <td class="label"> </td> + <td class="comment" colspan="5"> + <i><font size="-2"> + <&|/l&>(Sends a carbon-copy of this update to a comma-delimited list of email addresses. These people <strong>will</strong> receive future updates.)</&> + </font></i> + </td> +</tr> + +<tr> +<td class="label"> +<&|/l&>Admin Cc</&>: +</td> +<td class="value" colspan="5"><& /Elements/EmailInput, Name => 'AdminCc', Size => undef, Default => $ARGS{AdminCc} &></td> +</tr> + +<tr> + <td class="label"> </td> + <td class="comment" colspan="5"> + <i><font size="-2"> + <&|/l&>(Sends a carbon-copy of this update to a comma-delimited list of administrative email addresses. These people <strong>will</strong> receive future updates.)</&> + </font></i> + </td> +</tr> + +<tr> +<td class="label"> +<&|/l&>Subject</&>: +</td> +<td class="value" colspan="5"> +<input type="text" name="Subject" maxsize="200" value="<%$ARGS{Subject} || ''%>" /> +% $m->callback( %ARGS, CallbackName => 'AfterSubject' ); +</td> +</tr> + +% if ( $gnupg_widget ) { +<tr><td> </td><td colspan="5"> +<& /Elements/GnuPG/SignEncryptWidget, self => $gnupg_widget, QueueObj => $QueueObj &> +</td></tr> +% } + +<tr> +<td colspan="6"> +<&|/l&>Describe the issue below</&>:<br /> +% if ( RT->Config->Get('ArticleOnTicketCreate')) { +<& /Articles/Elements/BeforeMessageBox, %ARGS, QueueObj => $QueueObj &> +% } +% $m->callback( %ARGS, QueueObj => $QueueObj, CallbackName => 'BeforeMessageBox' ); +% if (exists $ARGS{Content}) { +<& /Elements/MessageBox, Default => $ARGS{Content}, IncludeSignature => 0 &> +% } else { +<& /Elements/MessageBox, QuoteTransaction => $QuoteTransaction &> +%} +% $m->callback( %ARGS, QueueObj => $QueueObj, CallbackName => 'AfterMessageBox' ); + +<br /> +</td> +</tr> + + <& /Ticket/Elements/AddAttachments, %ARGS, QueueObj => $QueueObj &> + </table> + </&> + <& /Elements/Submit, Label => loc("Create"), id => 'SubmitTicket' &> + </div> +</div> + +<div id="Ticket-Create-details"> +<a name="details"></a> +<table width="100%" border="0"> +<tr> +<td width="50%" valign="top" class="boxcontainer"> + <div class="ticket-info-basics"> + <&| /Widgets/TitleBox, title => loc('The Basics'), + title_class=> 'inverse', + color => "#993333" &> +<table border="0"> +<tr><td class="label"><&|/l&>Priority</&>:</td> +<td><& /Elements/SelectPriority, + Name => "InitialPriority", + Default => $ARGS{InitialPriority} ? $ARGS{InitialPriority} : $QueueObj->InitialPriority, +&></td></tr> +<tr><td class="label"><&|/l&>Final Priority</&>:</td> +<td><& /Elements/SelectPriority, + Name => "FinalPriority", + Default => $ARGS{FinalPriority} ? $ARGS{FinalPriority} : $QueueObj->FinalPriority, +&></td></tr> +<tr><td class="label"><&|/l&>Time Estimated</&>:</td> +<td> +<& /Elements/EditTimeValue, Name => 'TimeEstimated', Default => $ARGS{TimeEstimated} || '', InUnits => $ARGS{'TimeEstimated-TimeUnits'} &> + +</td></tr> +<tr><td class="label"><&|/l&>Time Worked</&>:</td> +<td> +<& /Elements/EditTimeValue, Name => 'TimeWorked', Default => $ARGS{TimeWorked} || '', InUnits => $ARGS{'TimeWorked-TimeUnits'} &> +</td></tr> +<tr> +<td class="label"><&|/l&>Time Left</&>:</td> +<td> +<& /Elements/EditTimeValue, Name => 'TimeLeft', Default => $ARGS{TimeLeft} || '', InUnits => $ARGS{'TimeLeft-TimeUnits'} &> +</td></tr> +</table> +</&> +<br /> +<div class="ticket-info-dates"> +<&|/Widgets/TitleBox, title => loc("Dates"), + title_class=> 'inverse', + color => "#663366" &> + +<table> +<tr><td class="label"><&|/l&>Starts</&>:</td><td><& /Elements/SelectDate, Name => "Starts", Default => $ARGS{Starts} || '' &></td></tr> +<tr><td class="label"><&|/l&>Due</&>:</td><td><& /Elements/SelectDate, Name => "Due", Default => $ARGS{Due} || '' &></td></tr> +</table> +</&> +</div> +</div> +<br /> +</td> + +<td valign="top" class="boxcontainer"> +<div class="ticket-info-links"> +<&| /Widgets/TitleBox, title => loc('Links'), title_class=> 'inverse' &> + +<em><&|/l&>(Enter ticket ids or URLs, separated with spaces)</&></em> +<table border="0"> +<tr><td class="label"><&|/l&>Depends on</&></td><td><input size="10" name="new-DependsOn" value="<% $ARGS{'new-DependsOn'} || '' %>" /></td></tr> +<tr><td class="label"><&|/l&>Depended on by</&></td><td><input size="10" name="DependsOn-new" value="<% $ARGS{'DependsOn-new'} || '' %>" /></td></tr> +<tr><td class="label"><&|/l&>Parents</&></td><td><input size="10" name="new-MemberOf" value="<% $ARGS{'new-MemberOf'} || '' %>" /></td></tr> +<tr><td class="label"><&|/l&>Children</&></td><td><input size="10" name="MemberOf-new" value="<% $ARGS{'MemberOf-new'} || '' %>" /></td></tr> +<tr><td class="label"><&|/l&>Refers to</&></td><td><input size="10" name="new-RefersTo" value="<% $ARGS{'new-RefersTo'} || '' %>" /></td></tr> +<tr><td class="label"><&|/l&>Referred to by</&></td><td><input size="10" name="RefersTo-new" value="<% $ARGS{'RefersTo-new'} || '' %>" /></td></tr> +<tr><td class="label">Customer ID</td><td><input size="10" name="new-Customer" value="<% $ARGS{'new-Customer'} || '' %>" /></td></tr> + +</table> +</&> +</div> +<br /> + +</td> +</tr> +</table> +<& /Elements/Submit, Label => loc("Create") &> +</div> +</form> + +<%INIT> +$m->callback( CallbackName => "Init", ARGSRef => \%ARGS ); +my $Queue = $ARGS{Queue}; +$session{DefaultQueue} = $Queue; + +if ($CloneTicket) { + my $CloneTicketObj = RT::Ticket->new( $session{CurrentUser} ); + $CloneTicketObj->Load($CloneTicket) + or Abort( loc("Ticket could not be loaded") ); + + my $clone = { + Requestors => join( ',', $CloneTicketObj->RequestorAddresses ), + Cc => join( ',', $CloneTicketObj->CcAddresses ), + AdminCc => join( ',', $CloneTicketObj->AdminCcAddresses ), + InitialPriority => $CloneTicketObj->Priority, + }; + + $clone->{$_} = $CloneTicketObj->$_() + for qw/Owner Subject FinalPriority Status/; + # not TimeWorked, TimeEstimated, or TimeLeft + + $clone->{$_} = $CloneTicketObj->$_->AsString + for grep { $CloneTicketObj->$_->Unix } + map { $_ . "Obj" } qw/Starts Started Due Resolved/; + + my $members = $CloneTicketObj->Members; + my ( @members, @members_of, @refers, @refers_by, @depends, @depends_by ); + my $refers = $CloneTicketObj->RefersTo; + my $get_link_value = sub { + my ($link, $type) = @_; + my $uri_method = $type . 'URI'; + my $local_method = 'Local' . $type; + my $uri = $link->$uri_method; + return if $uri->IsLocal and + $uri->Object and + $uri->Object->isa('RT::Ticket') and + $uri->Object->Type eq 'reminder'; + + return $link->$local_method || $uri->URI; + }; + while ( my $refer = $refers->Next ) { + my $refer_value = $get_link_value->($refer, 'Target'); + push @refers, $refer_value if defined $refer_value; + } + $clone->{'new-RefersTo'} = join ' ', @refers; + + my $refers_by = $CloneTicketObj->ReferredToBy; + while ( my $refer_by = $refers_by->Next ) { + my $refer_by_value = $get_link_value->($refer_by, 'Base'); + push @refers_by, $refer_by_value if defined $refer_by_value; + } + $clone->{'RefersTo-new'} = join ' ', @refers_by; + + my $cfs = $CloneTicketObj->QueueObj->TicketCustomFields(); + while ( my $cf = $cfs->Next ) { + next if $cf->FirstAttribute('NoClone'); + my $cf_id = $cf->id; + my $cf_values = $CloneTicketObj->CustomFieldValues( $cf->id ); + my @cf_values; + while ( my $cf_value = $cf_values->Next ) { + push @cf_values, $cf_value->Content; + } + + if ( @cf_values > 1 && $cf->Type eq 'Select' ) { + $clone->{"Object-RT::Ticket--CustomField-$cf_id-Value"} = \@cf_values; + } + else { + $clone->{"Object-RT::Ticket--CustomField-$cf_id-Value"} = join "\n", + @cf_values; + } + } + + # Pass customer links along (even though cloning of parent links + # in general is disabled). + my $customers = $CloneTicketObj->Customers; + my @customers; + while ( my $customer = $customers->Next ) { + my ($custnum) = $customer->Target =~ /cust_main\/(\d+)$/; + push @customers, $custnum if $custnum; + } + $clone->{'new-Customer'} = join(' ', @customers); + + for ( keys %$clone ) { + $ARGS{$_} = $clone->{$_} if not defined $ARGS{$_}; + } + +} + +my @results; + +my $title = loc("Create a new ticket"); + +my $QueueObj = RT::Queue->new($session{'CurrentUser'}); +$QueueObj->Load($Queue) || Abort(loc("Queue could not be loaded.")); + +$m->callback( QueueObj => $QueueObj, title => \$title, results => \@results, ARGSRef => \%ARGS ); + +$QueueObj->Disabled && Abort(loc("Cannot create tickets in a disabled queue.")); + +my $CFs = $QueueObj->TicketCustomFields(); + +my $ValidCFs = $m->comp( + '/Elements/ValidateCustomFields', + CustomFields => $CFs, + ARGSRef => \%ARGS +); + +ProcessAttachments(ARGSRef => \%ARGS); + +my $checks_failure = 0; + +my $gnupg_widget = $m->comp('/Elements/GnuPG/SignEncryptWidget:new', Arguments => \%ARGS ); +$m->comp( '/Elements/GnuPG/SignEncryptWidget:Process', + self => $gnupg_widget, + QueueObj => $QueueObj, +); + + +if ( !exists $ARGS{'AddMoreAttach'} && ($ARGS{'id'}||'') eq 'new' ) { + my $status = $m->comp('/Elements/GnuPG/SignEncryptWidget:Check', + self => $gnupg_widget, + Operation => 'Create', + QueueObj => $QueueObj, + ); + $checks_failure = 1 unless $status; +} + +# check email addresses for RT's +{ + foreach my $field ( qw(Requestors Cc AdminCc) ) { + my $value = $ARGS{ $field }; + next unless defined $value && length $value; + + my @emails = Email::Address->parse( $value ); + foreach my $email ( grep RT::EmailParser->IsRTAddress($_->address), @emails ) { + push @results, loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email->format, loc($field =~ /^(.*?)s?$/) ); + $checks_failure = 1; + $email = undef; + } + $ARGS{ $field } = join ', ', map $_->format, grep defined, @emails; + } +} + +my $skip_create = 0; +$m->callback( CallbackName => 'BeforeCreate', ARGSRef => \%ARGS, skip_create => \$skip_create, + checks_failure => $checks_failure, results => \@results ); + +$m->comp( '/Articles/Elements/CheckSkipCreate', ARGSRef => \%ARGS, skip_create => \$skip_create, + checks_failure => $checks_failure, results => \@results ); + +if ((!exists $ARGS{'AddMoreAttach'}) and (defined($ARGS{'id'}) and $ARGS{'id'} eq 'new')) { # new ticket? + if ( $ValidCFs && !$checks_failure && !$skip_create ) { +# CREATE THE TICKET. +# For some reason it's done by a Mason component named "Display.html" +# and the call is buried in obscure error-handling stuff. +# This comment exists to make it more visually obvious. +# ************************************************************ + + $m->comp('Display.html', %ARGS); + +# ************************************************************ +# Execution should not continue here. Display.html calls +# Redirect() which does an $m->abort. We only get here if the +# code dies before then, hence "$@". + $RT::Logger->crit("After display call; error is $@"); + $m->abort(); + } + elsif ( !$ValidCFs ) { + # Invalid CFs + while (my $CF = $CFs->Next) { + my $msg = $m->notes('InvalidField-' . $CF->Id) or next; + push @results, $CF->Name . ': ' . $msg; + } + } +} +PageMenu->child( basics => raw_html => q[<a href="#basics" onclick="return switchVisibility('Ticket-Create-basics','Ticket-Create-details');">] . loc('Basics') . q[</a>]); +PageMenu->child( details => raw_html => q[<a href="#details" onclick="return switchVisibility('Ticket-Create-details','Ticket-Create-basics');">] . loc('Details') . q[</a>]); +</%INIT> + +<%ARGS> +$DependsOn => undef +$DependedOnBy => undef +$MemberOf => undef +$QuoteTransaction => undef +$CloneTicket => undef +</%ARGS> diff --git a/rt/share/html/Ticket/Elements/EditTransactionCustomFields b/rt/share/html/Ticket/Elements/EditTransactionCustomFields index a52ecc349..89a2fab89 100644 --- a/rt/share/html/Ticket/Elements/EditTransactionCustomFields +++ b/rt/share/html/Ticket/Elements/EditTransactionCustomFields @@ -63,8 +63,9 @@ </<% $CELL %>> <<% $CELL %>> <& /Elements/EditCustomField, + %ARGS, CustomField => $CF, - NamePrefix => $NamePrefix + NamePrefix => $NamePrefix, &> % if (my $msg = $m->notes('InvalidField-' . $CF->Id)) { <br /> diff --git a/rt/share/html/Ticket/Elements/EditTransactionCustomFields.orig b/rt/share/html/Ticket/Elements/EditTransactionCustomFields.orig new file mode 100644 index 000000000..a52ecc349 --- /dev/null +++ b/rt/share/html/Ticket/Elements/EditTransactionCustomFields.orig @@ -0,0 +1,112 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +%# <sales@bestpractical.com> +%# +%# (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 }}} +% $m->callback( CallbackName => 'BeforeTransactionCustomFields', TicketObj => $TicketObj, QueueObj => $QueueObj, NamePrefix => $NamePrefix ); +% if ( $WRAP ) { +<<% $WRAP %> class="edit-transaction-custom-fields"> +% } +% if ($CustomFields->Count) { +% while (my $CF = $CustomFields->Next()) { +% $CF->SetContextObject($TicketObj || $QueueObj); +% next unless $CF->CurrentUserHasRight('ModifyCustomField'); +% next unless $CF->UILocation eq $UILocation; +<<% $FIELD %>> +<<% $CELL %> class="label cflabel"> + <span class="name"><% loc($CF->Name) %>:</span><br /> +% if ( $CF->Type ne 'TimeValue' ) { + <span class="type"><% $CF->FriendlyType %></span> +% } +</<% $CELL %>> +<<% $CELL %>> +<& /Elements/EditCustomField, + CustomField => $CF, + NamePrefix => $NamePrefix +&> +% if (my $msg = $m->notes('InvalidField-' . $CF->Id)) { + <br /> + <span class="cfinvalidfield"><% $msg %></span> +% } +</<% $CELL %>> +</<% $FIELD %>> +% } +% } +% if ( $WRAP ) { +</<% $WRAP %>> +% } +% $m->callback( CallbackName => 'AfterTransactionCustomFields', TicketObj => $TicketObj, QueueObj => $QueueObj, NamePrefix => $NamePrefix ); + +<%INIT> +my $CustomFields; + +if ($TicketObj) { + $CustomFields = $TicketObj->TransactionCustomFields(); +} else { + $CustomFields = $QueueObj->TicketTransactionCustomFields(); +} + +$m->callback( CallbackName => 'MassageTransactionCustomFields', CustomFields => $CustomFields ); + +$AsTable ||= $InTable; +my $FIELD = $AsTable ? 'tr' : 'div'; +my $CELL = $AsTable ? 'td' : 'div'; +my $WRAP = ''; +if ( $AsTable ) { + $WRAP = 'table' unless $InTable; +} else { + $WRAP = 'div'; +} + +</%INIT> +<%ARGS> +$NamePrefix => "Object-RT::Transaction--CustomField-" +$TicketObj => undef +$QueueObj => undef +$AsTable => 0 +$InTable => 0 +$UILocation => '' +</%ARGS> + diff --git a/rt/share/html/Ticket/Elements/PreviewScrips b/rt/share/html/Ticket/Elements/PreviewScrips index 3526f31a7..4067c20a3 100755 --- a/rt/share/html/Ticket/Elements/PreviewScrips +++ b/rt/share/html/Ticket/Elements/PreviewScrips @@ -88,7 +88,7 @@ my %squelched = ProcessTransactionSquelching( \%ARGS ); </ul> % } % if (RT->Config->Get('PreviewScripMessages')) { - <textarea cols="80" rows="5"><%$scrip->ActionObj->TemplateObj->MIMEObj->as_string%></textarea> + <textarea cols="80" rows="5"><% Encode::decode( "UTF-8", $scrip->ActionObj->TemplateObj->MIMEObj->as_string ) %></textarea> % } <br /> % } diff --git a/rt/share/html/Ticket/Elements/ShowUpdateStatus b/rt/share/html/Ticket/Elements/ShowUpdateStatus index 21713a43a..43b51b578 100644 --- a/rt/share/html/Ticket/Elements/ShowUpdateStatus +++ b/rt/share/html/Ticket/Elements/ShowUpdateStatus @@ -56,10 +56,10 @@ </div> <%ARGS> $Ticket +$DisplayPath => $session{'CurrentUser'}->Privileged ? 'Ticket' : 'SelfService' </%ARGS> <%INIT> return unless (RT->Config->Get( 'ShowUnreadMessageNotifications', $session{'CurrentUser'})); my $txn = $Ticket->SeenUpTo or return; -my $DisplayPath = $session{'CurrentUser'}->Privileged ? 'Ticket' : 'SelfService'; </%INIT> diff --git a/rt/share/html/Ticket/Graphs/Elements/ShowGraph b/rt/share/html/Ticket/Graphs/Elements/ShowGraph index 1eae4b6ae..e9a5102dc 100644 --- a/rt/share/html/Ticket/Graphs/Elements/ShowGraph +++ b/rt/share/html/Ticket/Graphs/Elements/ShowGraph @@ -46,7 +46,7 @@ %# %# END BPS TAGGED BLOCK }}} <div><img src="<% RT->Config->Get('WebPath') %>/Ticket/Graphs/<% $id %>?<% $m->comp('/Elements/QueryString', %ARGS) %>" usemap="#<% $graph->{'NAME'} || 'test' %>" style="border: none" /> -<% safe_run_child { Encode::decode_utf8( $graph->as_cmapx ) } |n %> +<% safe_run_child { Encode::decode( "UTF-8", $graph->as_cmapx ) } |n %> </div> <& ShowLegends, %ARGS, Ticket => $ticket &> <%ARGS> diff --git a/rt/share/html/Ticket/ModifyAll.html b/rt/share/html/Ticket/ModifyAll.html index 6fb79e4fe..119cae400 100755 --- a/rt/share/html/Ticket/ModifyAll.html +++ b/rt/share/html/Ticket/ModifyAll.html @@ -105,7 +105,7 @@ </td> </tr> - <tr><td colspan="2"><& /Ticket/Elements/EditTransactionCustomFields, %ARGS, TicketObj => $Ticket &></td></tr> + <tr><td colspan="2"><& /Ticket/Elements/EditTransactionCustomFields, %ARGS, TicketObj => $Ticket, KeepValue => 1, &></td></tr> <& /Ticket/Elements/AddAttachments, %ARGS, TicketObj => $Ticket &> diff --git a/rt/share/html/Ticket/Update.html b/rt/share/html/Ticket/Update.html index ae6b70095..37bb134c2 100755 --- a/rt/share/html/Ticket/Update.html +++ b/rt/share/html/Ticket/Update.html @@ -172,7 +172,7 @@ changeStatus(); % $m->callback( %ARGS, CallbackName => 'AfterWorked', Ticket => $TicketObj ); -<& /Ticket/Elements/EditTransactionCustomFields, %ARGS, TicketObj => $TicketObj, AsTable => 1 &> +<& /Ticket/Elements/EditTransactionCustomFields, %ARGS, TicketObj => $TicketObj, AsTable => 1, KeepValue => 1 &> <!--</table>--> </&> diff --git a/rt/share/html/Ticket/Update.html.orig b/rt/share/html/Ticket/Update.html.orig new file mode 100755 index 000000000..ae6b70095 --- /dev/null +++ b/rt/share/html/Ticket/Update.html.orig @@ -0,0 +1,353 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +%# <sales@bestpractical.com> +%# +%# (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 }}} +<& /Elements/Header, Title => $title &> +<& /Elements/Tabs &> + +% $m->callback(CallbackName => 'BeforeActionList', ARGSRef => \%ARGS, Ticket => $TicketObj); +<& /Elements/ListActions, actions => \@results &> + +<form action="Update.html" name="TicketUpdate" + method="post" enctype="multipart/form-data"> +% $m->callback( CallbackName => 'FormStart', ARGSRef => \%ARGS, Ticket => $TicketObj, CanRespond => $CanRespond, CanComment => $CanComment, ResponseDefault => $ResponseDefault, CommentDefault => $CommentDefault ); +<input type="hidden" class="hidden" name="QuoteTransaction" value="<% $ARGS{QuoteTransaction}||'' %>" /> +<input type="hidden" class="hidden" name="DefaultStatus" value="<% $DefaultStatus ||''%>" /> +<input type="hidden" class="hidden" name="Action" value="<% $ARGS{Action}||'' %>" /> + +<& /Elements/GnuPG/SignEncryptWidget:ShowIssues, self => $gnupg_widget &> + +<div id="ticket-update-metadata"> + <&|/Widgets/TitleBox, title => loc('Ticket and Transaction') &> +<table width="100%" border="0"> +% $m->callback(CallbackName => 'AfterTableOpens', ARGSRef => \%ARGS, Ticket => $TicketObj); + +<& /Ticket/Elements/EditTransactionCustomFields, + %ARGS, + TicketObj => $TicketObj, + UILocation => 'TimeWorked', +&> + +% my $skip; +% $m->callback( %ARGS, CallbackName => 'BeforeUpdateType', skip => \$skip ); +% if (!$skip) { +<input type="hidden" class="hidden" name="id" value="<%$TicketObj->Id%>" /><br /> +% } +<tr><td class="label"><&|/l&>Update Type</&>:</td> +<td><select name="UpdateType" id="UpdateType"> +% if ($CanComment) { +<option value="private" <% ($ARGS{'UpdateType'} && $ARGS{'UpdateType'} eq "private") ? qq[ selected="selected"] : !$ARGS{'UpdateType'}&&$CommentDefault |n %>><&|/l&>Comments (Not sent to requestors)</&></option> +% } +% if ($CanRespond) { +<option value="response" <% ($ARGS{'UpdateType'} && $ARGS{'UpdateType'} eq "response") ? qq[ selected="selected"] : !$ARGS{'UpdateType'}&&$ResponseDefault |n %>><&|/l&>Reply to requestors</&></option> +% } +</select> + +<script type="text/javascript"> + jQuery(function() { + jQuery("#UpdateType").change(function(ev) { + jQuery(".messagebox-container") + .removeClass("action-response action-private") + .addClass("action-"+ev.target.value); + }); + }); + jQuery(function() { + jQuery("input[name=TxnSendMailTo]").change(function(ev) { + jQuery("input[name=TxnSendMailTo][value="+ev.target.value+"]") + .attr("checked",jQuery(ev.target).attr('checked')); + }); + }); +</script> + +% $m->callback( %ARGS, CallbackName => 'AfterUpdateType' ); +</td></tr> + +<script type="text/javascript"> +function changeStatus() { + var Status_select = document.getElementById('Status'); + var x = Status_select.options[Status_select.selectedIndex].value; + var text = document.getElementById('WillResolve_Date'); + var button = document.getElementById('WillResolve_Date_date_button'); + if (x == 'resolved' || x == 'rejected' || x == 'deleted') { + text.disabled = true; + button.style.display = 'none'; + } + else { + text.disabled = false; + button.style.display = 'inline'; + } +} +</script> + +<& /Ticket/Elements/EditBasics, + TicketObj => $TicketObj, + InTable => 1, + fields => [ + { name => 'Status', + comp => '/Elements/SelectStatus', + args => { + Name => 'Status', + DefaultLabel => loc("[_1] (Unchanged)", loc($TicketObj->Status)), + Default => $ARGS{'Status'} || ($TicketObj->Status eq $DefaultStatus ? undef : $DefaultStatus), + TicketObj => $TicketObj, + QueueObj => $TicketObj->QueueObj, + onchange => 'changeStatus()' + }, + }, + { name => 'Resolve this Ticket on', + comp => '/Elements/SelectDate', + args => { + menu_prefix => 'WillResolve', + current => 0, + ShowTime => 0, + }, + }, + { name => 'Owner', + comp => '/Elements/SelectOwner', + args => { + Name => "Owner", + TicketObj => $TicketObj, + QueueObj => $TicketObj->QueueObj, + DefaultLabel => loc("[_1] (Unchanged)", $m->scomp('/Elements/ShowUser', User => $TicketObj->OwnerObj)), + Default => $ARGS{'Owner'} + } + }, + { name => 'Worked', + comp => '/Elements/EditTimeValue', + args => { + Name => 'UpdateTimeWorked', + Default => $ARGS{UpdateTimeWorked}||'', + InUnits => $ARGS{'UpdateTimeWorked-TimeUnits'}||'minutes', + } + }, + ] +&> + +<script type="text/javascript"> +changeStatus(); +</script> + +% $m->callback( %ARGS, CallbackName => 'AfterWorked', Ticket => $TicketObj ); + +<& /Ticket/Elements/EditTransactionCustomFields, %ARGS, TicketObj => $TicketObj, AsTable => 1 &> + + <!--</table>--> + </&> +</div> + +<div id="ticket-update-message"> + <& /Ticket/Elements/ShowSimplifiedRecipients, TicketObj => $TicketObj, %ARGS &> + + <&|/Widgets/TitleBox, title => loc('Message'), class => 'messagedetails' &> + <table width="100%" border="0"> +<& /Ticket/Elements/UpdateCc, %ARGS, TicketObj => $TicketObj &> + +% if ( $gnupg_widget ) { +<tr><td> </td><td> +<& /Elements/GnuPG/SignEncryptWidget, + self => $gnupg_widget, + TicketObj => $TicketObj, +&> +</td></tr> +% } +% $m->callback( %ARGS, CallbackName => 'AfterGnuPG' ); + +<tr><td class="label"><&|/l&>Subject</&>:</td><td> <input type="text" name="UpdateSubject" value="<% $ARGS{UpdateSubject} || $TicketObj->Subject || '' %>" /> +% $m->callback( %ARGS, CallbackName => 'AfterSubject' ); +</td></tr> + +<tr><td class="label" valign="top"><&|/l&>Message</&>:</td> +<td class="messagebox-container action-<% $type %>"> +<& /Articles/Elements/BeforeMessageBox, %ARGS &> +% $m->callback( %ARGS, CallbackName => 'BeforeMessageBox' ); +% if (exists $ARGS{UpdateContent}) { +% # preserve QuoteTransaction so we can use it to set up sane references/in/reply to +% my $temp = $ARGS{'QuoteTransaction'}; +% delete $ARGS{'QuoteTransaction'}; +<& /Elements/MessageBox, Name=>"UpdateContent", Default=>$ARGS{UpdateContent}, IncludeSignature => 0, %ARGS&> +% $ARGS{'QuoteTransaction'} = $temp; +% } else { +% my $IncludeSignature = 1; +% $IncludeSignature = 0 if $Action ne 'Respond' && !RT->Config->Get('MessageBoxIncludeSignatureOnComment'); +<& /Elements/MessageBox, Name=>"UpdateContent", IncludeSignature => $IncludeSignature, %ARGS &> +% } +% $m->callback( %ARGS, CallbackName => 'AfterMessageBox' ); +</td></tr> + + <& /Ticket/Elements/AddAttachments, %ARGS, TicketObj => $TicketObj &> + </table> +</&> + +% $m->callback( %ARGS, CallbackName => 'BeforeSubmit', Ticket => $TicketObj ); + + <& /Elements/Submit, Label => loc('Update Ticket'), Name => 'SubmitTicket', id => 'SubmitTicket' &> + +% $m->callback( %ARGS, CallbackName => 'BeforeScrips', Ticket => $TicketObj ); + +% if ($TicketObj->CurrentUserHasRight('ShowOutgoingEmail')) { + <&|/Widgets/TitleBox, title => loc('Scrips and Recipients'), id => 'previewscrips', rolledup => RT->Config->Get('SimplifiedRecipients', $session{'CurrentUser'}) &> + <& /Ticket/Elements/PreviewScrips, TicketObj => $TicketObj, %ARGS &> + </&> +% } +</div> + +% $m->callback( %ARGS, CallbackName => 'AfterScrips', Ticket => $TicketObj ); + +% if (my $recips = $m->notes("DryRun-Recipients-".$TicketObj->Id)) { +<input type="hidden" name="TxnRecipients" value="<% join ",",sort keys %{$recips} %>" /> +% } + +</form> +<hr class="clear" /> + +% $m->callback( %ARGS, CallbackName => 'AfterForm', Ticket => $TicketObj ); + +<%INIT> +my $CanRespond = 0; +my $CanComment = 0; +my $checks_failure = 0; + +my $TicketObj = LoadTicket($id); + +my @results; + +$m->callback( Ticket => $TicketObj, ARGSRef => \%ARGS, checks_failure => \$checks_failure, results => \@results, CallbackName => 'Initial' ); + +unless($DefaultStatus){ + $DefaultStatus=($ARGS{'Status'} ||$TicketObj->Status()); +} + +my $title = loc("Update ticket #[_1] ([_2])", $TicketObj->id, $TicketObj->Subject||''); + +# Things needed in the template - we'll do the processing here, just +# for the convenience: + +my ($CommentDefault, $ResponseDefault); +if ($Action ne 'Respond') { + $CommentDefault = qq[ selected="selected"]; + $ResponseDefault = ""; +} else { + $CommentDefault = ""; + $ResponseDefault = qq[ selected="selected"]; +} + +my $type = $ARGS{'UpdateType'} ? $ARGS{'UpdateType'} : + lc $ARGS{'Action'} eq 'respond' ? 'response' : + lc $ARGS{'Action'} eq 'comment' ? 'private' : + 'none' ; + + +$CanRespond = 1 if ( $TicketObj->CurrentUserHasRight('ReplyToTicket') or + $TicketObj->CurrentUserHasRight('ModifyTicket') ); + +$CanComment = 1 if ( $TicketObj->CurrentUserHasRight('CommentOnTicket') or + $TicketObj->CurrentUserHasRight('ModifyTicket') ); + + +ProcessAttachments(ARGSRef => \%ARGS); + +my $gnupg_widget = $m->comp('/Elements/GnuPG/SignEncryptWidget:new', Arguments => \%ARGS ); +$m->comp( '/Elements/GnuPG/SignEncryptWidget:Process', + self => $gnupg_widget, + TicketObj => $TicketObj, +); + +if ( $ARGS{'SubmitTicket'} ) { + + my %squelched = ProcessTransactionSquelching( \%ARGS ); + $ARGS{'SquelchMailTo'} = [keys %squelched] if keys %squelched; + + my $CFs = $TicketObj->TransactionCustomFields; + my $ValidCFs = $m->comp( + '/Elements/ValidateCustomFields', + CustomFields => $CFs, + NamePrefix => "Object-RT::Transaction--CustomField-", + ARGSRef => \%ARGS + ); + unless ( $ValidCFs ) { + $checks_failure = 1; + while (my $CF = $CFs->Next) { + my $msg = $m->notes('InvalidField-' . $CF->Id) or next; + push @results, loc($CF->Name) . ': ' . $msg; + } + } + my $status = $m->comp('/Elements/GnuPG/SignEncryptWidget:Check', + self => $gnupg_widget, + TicketObj => $TicketObj, + ); + $checks_failure = 1 unless $status; +} + +# check email addresses for RT's +{ + foreach my $field ( qw(UpdateCc UpdateBcc) ) { + my $value = $ARGS{ $field }; + next unless defined $value && length $value; + + my @emails = Email::Address->parse( $value ); + foreach my $email ( grep RT::EmailParser->IsRTAddress($_->address), @emails ) { + push @results, loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email->format, loc(substr($field, 6)) ); + $checks_failure = 1; + $email = undef; + } + $ARGS{ $field } = join ', ', map $_->format, grep defined, @emails; + } +} +my $skip_update = 0; +$m->callback( CallbackName => 'BeforeUpdate', ARGSRef => \%ARGS, skip_update => \$skip_update, + checks_failure => $checks_failure, results => \@results, TicketObj => $TicketObj ); + +if ( !$checks_failure && !$skip_update && exists $ARGS{SubmitTicket} ) { + $m->callback( Ticket => $TicketObj, ARGSRef => \%ARGS, CallbackName => 'BeforeDisplay' ); + return $m->comp('Display.html', TicketObj => $TicketObj, %ARGS); +} +</%INIT> + +<%ARGS> +$id => undef +$Action => undef +$DefaultStatus => undef +</%ARGS> diff --git a/rt/share/html/Tools/Offline.html b/rt/share/html/Tools/Offline.html index 507ca17e2..de49e00c8 100644 --- a/rt/share/html/Tools/Offline.html +++ b/rt/share/html/Tools/Offline.html @@ -114,7 +114,6 @@ if ($ARGS{'Parse'} && $ARGS{'Template'}) { $template .= $buffer; } my $encode = RT::I18N::_GuessCharset( $template ); - require Encode; $template = Encode::decode( $encode, $template ); $template =~ s/\r\n/\n/gs; $action->Parse(Content => $template, Queue => $qname, Requestor => $requestoraddress); diff --git a/rt/share/html/Widgets/TitleBoxStart b/rt/share/html/Widgets/TitleBoxStart index f6655edad..4982315fe 100755 --- a/rt/share/html/Widgets/TitleBoxStart +++ b/rt/share/html/Widgets/TitleBoxStart @@ -81,7 +81,7 @@ $hideable = 1 if $rolledup; # my $page = $m->request_comp->path; -my $title_b64 = MIME::Base64::encode_base64(Encode::encode_utf8($title), ''); +my $title_b64 = MIME::Base64::encode_base64(Encode::encode( "UTF-8", $title), ''); my $tid = "TitleBox--$page--" . join '--', ($class, $bodyclass, $title_b64, $id); diff --git a/rt/t/00-mason-syntax.t b/rt/t/00-mason-syntax.t index 0f77876ae..ac0da0d58 100644 --- a/rt/t/00-mason-syntax.t +++ b/rt/t/00-mason-syntax.t @@ -20,12 +20,11 @@ use HTML::Mason; use HTML::Mason::Compiler; use HTML::Mason::Compiler::ToObject; BEGIN { require RT::Test; } -use Encode qw(decode_utf8); sub compile_file { my $file = shift; - my $text = decode_utf8(RT::Test->file_content($file)); + my $text = Encode::decode( "UTF-8", RT::Test->file_content($file)); my $compiler = new HTML::Mason::Compiler::ToObject; $compiler->compile( diff --git a/rt/t/99-policy.t b/rt/t/99-policy.t new file mode 100644 index 000000000..1980e342f --- /dev/null +++ b/rt/t/99-policy.t @@ -0,0 +1,101 @@ +use strict; +use warnings; + +use RT::Test nodb => 1; +use File::Find; + +my @files; +find( sub { push @files, $File::Find::name if -f }, + qw{etc lib share t bin sbin devel/tools} ); +if ( my $dir = `git rev-parse --git-dir 2>/dev/null` ) { + # We're in a git repo, use the ignore list + chomp $dir; + my %ignores; + $ignores{ $_ }++ for grep $_, split /\n/, + `git ls-files -o -i --exclude-standard .`; + @files = grep {not $ignores{$_}} @files; +} + +sub check { + my $file = shift; + my %check = ( + strict => 0, + warnings => 0, + shebang => 0, + exec => 0, + bps_tag => 0, + @_, + ); + + if ($check{strict} or $check{warnings} or $check{shebang} or $check{bps_tag}) { + local $/; + open my $fh, '<', $file or die $!; + my $content = <$fh>; + + like( + $content, + qr/^use strict(?:;|\s+)/m, + "$file has 'use strict'" + ) if $check{strict}; + + like( + $content, + qr/^use warnings(?:;|\s+)/m, + "$file has 'use warnings'" + ) if $check{warnings}; + + if ($check{shebang} == 1) { + like( $content, qr/^#!/, "$file has shebang" ); + } elsif ($check{shebang} == -1) { + unlike( $content, qr/^#!/, "$file has no shebang" ); + } + + $check{bps_tag} = -1 if $check{bps_tag} == 1 + and not $content =~ /Copyright\s+\(c\)\s+\d\d\d\d-\d\d\d\d Best Practical Solutions/i + and $file =~ /(?:ckeditor|scriptaculous|superfish|tablesorter|farbtastic)/i; + $check{bps_tag} = -1 if $check{bps_tag} == 1 + and not $content =~ /Copyright\s+\(c\)\s+\d\d\d\d-\d\d\d\d Best Practical Solutions/i + and ($content =~ /\b(copyright|GPL|Public Domain)\b/i + or /\(c\)\s+\d\d\d\d(?:-\d\d\d\d)?/i); + if ($check{bps_tag} == 1) { + like( $content, qr/[B]EGIN BPS TAGGED BLOCK {{{/, "$file has BPS license tag"); + } elsif ($check{bps_tag} == -1) { + unlike( $content, qr/[B]EGIN BPS TAGGED BLOCK {{{/, "$file has no BPS license tag"); + } + } + + my $executable = ( stat $file )[2] & 0100; + if ($check{exec} == 1) { + if ( $file =~ /\.in$/ ) { + ok( !$executable, "$file permission is u-x (.in will add +x)" ); + } else { + ok( $executable, "$file permission is u+x" ); + } + } elsif ($check{exec} == -1) { + ok( !$executable, "$file permission is u-x" ); + } +} + +check( $_, shebang => -1, exec => -1, warnings => 1, strict => 1, bps_tag => 1 ) + for grep {m{^lib/.*\.pm$}} @files; + +check( $_, shebang => -1, exec => -1, warnings => 1, strict => 1, bps_tag => -1 ) + for grep {m{^t/.*\.t$}} @files; + +check( $_, shebang => 1, exec => 1, warnings => 1, strict => 1, bps_tag => 1 ) + for grep {m{^s?bin/}} @files; + +check( $_, shebang => 1, exec => 1, warnings => 1, strict => 1, bps_tag => 1 ) + for grep {m{^devel/tools/} and not m{/(localhost\.(crt|key)|mime\.types)$}} @files; + +check( $_, exec => -1, bps_tag => not m{\.(png|gif|jpe?g)$} ) + for grep {m{^share/html/}} @files; + +check( $_, exec => -1 ) + for grep {m{^share/(po|fonts)/}} @files; + +check( $_, exec => -1 ) + for grep {m{^t/data/}} @files; + +check( $_, exec => -1, bps_tag => -1 ) + for grep {m{^etc/upgrade/[^/]+/}} @files; diff --git a/rt/t/api/attachment.t b/rt/t/api/attachment.t index 8b7cb608b..52e3c3f16 100644 --- a/rt/t/api/attachment.t +++ b/rt/t/api/attachment.t @@ -58,10 +58,9 @@ is ($#headers, 2, "testing a bunch of singline multiple headers" ); my $mime = $attachment->ContentAsMIME; like( $mime->head->get('Content-Type'), qr/charset="iso-8859-1"/, 'content type of ContentAsMIME is original' ); - require Encode; is( Encode::decode( 'iso-8859-1', $mime->stringify_body ), - Encode::decode( 'utf8', "Håvard\n" ), + Encode::decode( 'UTF-8', "Håvard\n" ), 'body of ContentAsMIME is original' ); } diff --git a/rt/t/api/canonical_charset.t b/rt/t/api/canonical_charset.t index a426d89b6..86c3e97b3 100644 --- a/rt/t/api/canonical_charset.t +++ b/rt/t/api/canonical_charset.t @@ -3,7 +3,6 @@ use strict; use RT::Test nodata => 1, tests => 11; use RT::I18N; -use Encode; my %map = ( 'euc-cn' => 'gbk', @@ -22,7 +21,7 @@ for my $charset ( keys %map ) { my $mime = MIME::Entity->build( Type => 'text/plain; charset=gb2312', - Data => [encode('gbk', decode_utf8("法新社倫敦11日電"))], + Data => [Encode::encode("gbk", Encode::decode( "UTF-8", "法新社倫敦11日電"))], ); RT::I18N::SetMIMEEntityToUTF8($mime); diff --git a/rt/t/api/cfsearch.t b/rt/t/api/cfsearch.t new file mode 100644 index 000000000..7a460ce2e --- /dev/null +++ b/rt/t/api/cfsearch.t @@ -0,0 +1,106 @@ +use strict; +use warnings; + +use RT::Test tests => 18; + +my $suffix = '-'. $$; + +use_ok 'RT::Users'; +use_ok 'RT::CustomField'; + +my $u1 = RT::User->new( RT->SystemUser ); +isa_ok( $u1, 'RT::User' ); +ok( $u1->Load('root'), "Loaded user 'root'" ); + +# create cf +my $cfname = 'TestUserCF'. $suffix; +my $cf = RT::CustomField->new( RT->SystemUser ); +isa_ok( $cf, 'RT::CustomField' ); + +{ + my ($id, $msg) = $cf->Create( + Name => $cfname, + LookupType => 'RT::User', + Type => 'Freeform', + Description => 'Freeform CF for tests', + ); + ok( $id, "Created cf '$cfname' - " . $msg ); +} + +{ + my ($status, $msg) = $cf->AddToObject( $u1 ); + ok( $status, "Added CF to user object - " . $msg); +} + +my $cfvalue1 = 'Foo'; + +{ + my ($id, $msg) = $u1->AddCustomFieldValue( + Field => $cfname, + Value => $cfvalue1, + RecordTransaction => 0 ); + ok( $id, "Adding CF value '$cfvalue1' - " . $msg ); +} + +# Confirm value is returned. +{ + my $cf_value_ref = QueryCFValue( $cfvalue1, $cf->id ); + is( scalar(@$cf_value_ref), 1, 'Got one value.' ); + is( $cf_value_ref->[0], 'Foo', 'Got Foo back for value.' ); +} + +{ + my ($id, $msg) = $u1->DeleteCustomFieldValue( + Field => $cfname, + Value => $cfvalue1, + RecordTransaction => 0 ); + ok( $id, "Deleting CF value - " . $msg ); +} + +my $cfvalue2 = 'Bar'; +{ + my ($id, $msg) = $u1->AddCustomFieldValue( + Field => $cfname, + Value => $cfvalue2, + RecordTransaction => 0 ); + ok( $id, "Adding second CF value '$cfvalue2' - " . $msg ); +} + +# Confirm no value is returned for Foo. +{ + # Calling with $cfvalue1 on purpose to confirm + # it has been disabled by the delete above. + + my $cf_value_ref = QueryCFValue( $cfvalue1, $cf->id ); + is( scalar(@$cf_value_ref), 0, 'No values returned for Foo.' ); +} + +# Confirm value is returned for Bar. +{ + my $cf_value_ref = QueryCFValue( $cfvalue2, $cf->id ); + is( scalar(@$cf_value_ref), 1, 'Got one value.' ); + is( $cf_value_ref->[0], 'Bar', 'Got Bar back for value.' ); +} + + +sub QueryCFValue{ + my $cf_value = shift; + my $cf_id = shift; + my @cf_value_strs; + + my $users = RT::Users->new(RT->SystemUser); + isa_ok( $users, 'RT::Users' ); + + $users->LimitCustomField( + CUSTOMFIELD => $cf_id, + OPERATOR => "=", + VALUE => $cf_value ); + + while ( my $filtered_user = $users->Next() ){ + my $cf_values = $filtered_user->CustomFieldValues($cf->id); + while (my $cf_value = $cf_values->Next() ){ + push @cf_value_strs, $cf_value->Content; + } + } + return \@cf_value_strs; +} diff --git a/rt/t/api/i18n_guess.t b/rt/t/api/i18n_guess.t index 956cb1505..a64b2952c 100644 --- a/rt/t/api/i18n_guess.t +++ b/rt/t/api/i18n_guess.t @@ -4,8 +4,6 @@ use warnings; use RT::Test tests => 16; -use Encode qw(encode); - use constant HAS_ENCODE_GUESS => do { local $@; eval { require Encode::Guess; 1 } }; use constant HAS_ENCODE_DETECT => do { local $@; eval { require Encode::Detect::Detector; 1 } }; diff --git a/rt/t/api/menu.t b/rt/t/api/menu.t new file mode 100644 index 000000000..a9cda69c7 --- /dev/null +++ b/rt/t/api/menu.t @@ -0,0 +1,85 @@ +use strict; +use warnings; + +use RT::Test tests => undef; +use RT::Interface::Web::Menu; + +sub child_path_is($$$) { + my ($menu, $child, $expected) = @_; + my $c = $menu->child($child->[0], path => $child->[1]); + is $c->path, $expected, "'$child->[1]' normalizes to '$expected'"; + return $c; +} + +{ + package FakeRequest; + sub new { bless {}, shift } + sub path_info { "" } + + package FakeInterp; + require CGI; + sub new { bless {}, shift } + sub cgi_object { CGI->new } +} + +local $HTML::Mason::Commands::r = FakeRequest->new; +local $HTML::Mason::Commands::m = FakeInterp->new; + +my $menu = RT::Interface::Web::Menu->new; +ok $menu, "Created top level menu"; + +child_path_is $menu, [search => "Search/Simple.html"], "/Search/Simple.html"; +child_path_is $menu, [absolute => "/Prefs/Other.html"], "/Prefs/Other.html"; +child_path_is $menu, [scheme => "http://example.com"], "http://example.com"; + +my $tools = + child_path_is $menu, [tools => "/Tools/"], "/Tools/"; + child_path_is $tools, [myday => "MyDay.html"], "/Tools/MyDay.html"; + child_path_is $tools, [activity => "/Activity.html"], "/Activity.html"; + my $ext = + child_path_is $tools, [external => "http://example.com"], "http://example.com"; + child_path_is $ext, [wiki => "wiki/"], "http://example.com/wiki/"; + +# Pathological case of multiplying slashes +my $home = + child_path_is $menu, [home => "/"], "/"; + child_path_is $home, [slash => "/"], "/"; + child_path_is $home, [empty => ""], "/"; + + + +sub order_ok($$;$) { + my ($menu, $expected, $name) = @_; + my @children = $menu->children; + + is scalar @children, scalar @$expected, "correct number of children"; + is_deeply [map { $_->key } @children], $expected, $name; + + my $last_child = shift @children; # first child's sort doesn't matter + for (@children) { + ok $_->sort_order > $last_child->sort_order, sprintf "%s order higher than %s's", $_->key, $last_child->key; + $last_child = $_; + } +} + +$menu = RT::Interface::Web::Menu->new; + +ok $menu->child("foo", title => "foo"), "added child foo"; +order_ok $menu, [qw(foo)], "sorted"; + +ok $menu->child("foo")->add_after("bar", title => "bar"), "added child bar after foo"; +order_ok $menu, [qw(foo bar)], "sorted after"; + +ok $menu->child("bar")->add_before("baz", title => "baz"), "added child baz before bar"; +order_ok $menu, [qw(foo baz bar)], "sorted before (in between)"; + +ok $menu->child("bat", title => "bat", sort_order => 2.2), "added child bat between baz and bar"; +order_ok $menu, [qw(foo baz bat bar)], "sorted between manually"; + +ok $menu->child("bat")->add_before("pre", title => "pre"), "added child pre before bat"; +order_ok $menu, [qw(foo baz pre bat bar)], "sorted between (before)"; + +ok $menu->child("bat")->add_after("post", title => "post"), "added child post after bat"; +order_ok $menu, [qw(foo baz pre bat post bar)], "sorted between (after)"; + +done_testing; diff --git a/rt/t/api/password-types.t b/rt/t/api/password-types.t index 10a874a3d..4cb634248 100644 --- a/rt/t/api/password-types.t +++ b/rt/t/api/password-types.t @@ -3,8 +3,6 @@ use warnings; use RT::Test; use Digest::MD5; -use Encode 'encode_utf8'; -use utf8; my $default = "sha512"; @@ -43,9 +41,9 @@ like($root->__Value("Password"), qr/^\!$default\!/, "And is now upgraded to salt # Non-ASCII salted truncated SHA-256 my $non_ascii_trunc = MIME::Base64::encode_base64( - "salt" . substr(Digest::SHA::sha256("salt".Digest::MD5::md5(encode_utf8("áěšý"))),0,26), + "salt" . substr(Digest::SHA::sha256("salt".Digest::MD5::md5("áěšý")),0,26), "" ); $root->_Set( Field => "Password", Value => $non_ascii_trunc); -ok($root->IsPassword("áěšý"), "Unsalted MD5 base64 works"); +ok($root->IsPassword(Encode::decode("UTF-8", "áěšý")), "Unsalted MD5 base64 works"); like($root->__Value("Password"), qr/^\!$default\!/, "And is now upgraded to salted $default"); diff --git a/rt/t/api/template-parsing.t b/rt/t/api/template-parsing.t new file mode 100644 index 000000000..455b84d27 --- /dev/null +++ b/rt/t/api/template-parsing.t @@ -0,0 +1,306 @@ +use strict; +use warnings; +use RT; +use RT::Test tests => 266; +use Test::Warn; + +my $queue = RT::Queue->new(RT->SystemUser); +$queue->Load("General"); + +my $ticket_cf = RT::CustomField->new(RT->SystemUser); +$ticket_cf->Create( + Name => 'Department', + Queue => '0', + Type => 'FreeformSingle', +); + +my $txn_cf = RT::CustomField->new(RT->SystemUser); +$txn_cf->Create( + Name => 'Category', + LookupType => RT::Transaction->CustomFieldLookupType, + Type => 'FreeformSingle', +); +$txn_cf->AddToObject($queue); + +my $ticket = RT::Ticket->new(RT->SystemUser); +my ($id, $msg) = $ticket->Create( + Subject => "template testing", + Queue => "General", + Owner => 'root@localhost', + Requestor => ["dom\@example.com"], + "CustomField-" . $txn_cf->id => "Special", +); +ok($id, "Created ticket: $msg"); +my $txn = $ticket->Transactions->First; + +$ticket->AddCustomFieldValue( + Field => 'Department', + Value => 'Coolio', +); + +TemplateTest( + Content => "\ntest", + PerlOutput => "test", + SimpleOutput => "test", +); + +TemplateTest( + Content => "\ntest { 5 * 5 }", + PerlOutput => "test 25", + SimpleOutput => "test { 5 * 5 }", +); + +TemplateTest( + Content => "\ntest { \$Requestor }", + PerlOutput => "test dom\@example.com", + SimpleOutput => "test dom\@example.com", +); + +TemplateTest( + Content => "\ntest { \$TicketSubject }", + PerlOutput => "test ", + SimpleOutput => "test template testing", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketQueueId }", + Output => "test 1", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketQueueName }", + Output => "test General", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketOwnerId }", + Output => "test 12", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketOwnerName }", + Output => "test root", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketOwnerEmailAddress }", + Output => "test root\@localhost", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketStatus }", + Output => "test new", +); + +SimpleTemplateTest( + Content => "\ntest #{ \$TicketId }", + Output => "test #" . $ticket->id, +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketCFDepartment }", + Output => "test Coolio", +); + +SimpleTemplateTest( + Content => "\ntest #{ \$TransactionId }", + Output => "test #" . $txn->id, +); + +SimpleTemplateTest( + Content => "\ntest { \$TransactionType }", + Output => "test Create", +); + +SimpleTemplateTest( + Content => "\ntest { \$TransactionCFCategory }", + Output => "test Special", +); + +SimpleTemplateTest( + Content => "\ntest { \$TicketDelete }", + Output => "test { \$TicketDelete }", +); + +SimpleTemplateTest( + Content => "\ntest { \$Nonexistent }", + Output => "test { \$Nonexistent }", +); + +warning_like { + TemplateTest( + Content => "\ntest { \$Ticket->Nonexistent }", + PerlOutput => undef, + SimpleOutput => "test { \$Ticket->Nonexistent }", + ); +} qr/RT::Ticket::Nonexistent Unimplemented/; + +warning_like { + TemplateTest( + Content => "\ntest { \$Nonexistent->Nonexistent }", + PerlOutput => undef, + SimpleOutput => "test { \$Nonexistent->Nonexistent }", + ); +} qr/Can't call method "Nonexistent" on an undefined value/; + +TemplateTest( + Content => "\ntest { \$Ticket->OwnerObj->Name }", + PerlOutput => "test root", + SimpleOutput => "test { \$Ticket->OwnerObj->Name }", +); + +warning_like { + TemplateTest( + Content => "\ntest { *!( }", + SyntaxError => 1, + PerlOutput => undef, + SimpleOutput => "test { *!( }", + ); +} qr/Template parsing error: syntax error/; + +TemplateTest( + Content => "\ntest { \$rtname ", + SyntaxError => 1, + PerlOutput => undef, + SimpleOutput => undef, +); + +is($ticket->Status, 'new', "test setup"); +SimpleTemplateTest( + Content => "\ntest { \$Ticket->SetStatus('resolved') }", + Output => "test { \$Ticket->SetStatus('resolved') }", +); +is($ticket->Status, 'new', "simple templates can't call ->SetStatus"); + +note "test arguments passing"; +{ + PerlTemplateTest( + Content => "\ntest { \$Nonexistent }", + Output => "test ", + ); + PerlTemplateTest( + Content => "\ntest { \$Nonexistent }", + Arguments => { Nonexistent => 'foo' }, + Output => "test foo", + ); + + PerlTemplateTest( + Content => "\n".'array: { join ", ", @array }', + Arguments => { array => [qw(foo bar)] }, + Output => "array: foo, bar", + ); + PerlTemplateTest( + Content => "\n".'hash: { join ", ", map "$_ => $hash{$_}", sort keys %hash }', + Arguments => { hash => {1 => 2, a => 'b'} }, + Output => "hash: 1 => 2, a => b", + ); + PerlTemplateTest( + Content => "\n".'code: { code() }', + Arguments => { code => sub { "baz" } }, + Output => "code: baz", + ); +} + +# Make sure changing the template's type works +{ + my $template = RT::Template->new(RT->SystemUser); + $template->Create( + Name => "type chameleon", + Type => "Perl", + Content => "\ntest { 10 * 7 }", + ); + ok($id = $template->id, "Created template"); + $template->Parse; + is($template->MIMEObj->stringify_body, "test 70", "Perl output"); + + $template = RT::Template->new(RT->SystemUser); + $template->Load($id); + is($template->Name, "type chameleon"); + + $template->SetType('Simple'); + $template->Parse; + is($template->MIMEObj->stringify_body, "test { 10 * 7 }", "Simple output"); + + $template = RT::Template->new(RT->SystemUser); + $template->Load($id); + is($template->Name, "type chameleon"); + + $template->SetType('Perl'); + $template->Parse; + is($template->MIMEObj->stringify_body, "test 70", "Perl output"); +} + +undef $ticket; + +my $counter = 0; +sub IndividualTemplateTest { + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my %args = ( + Name => "Test-" . ++$counter, + Type => "Perl", + @_, + ); + + my $t = RT::Template->new(RT->SystemUser); + $t->Create( + Name => $args{Name}, + Type => $args{Type}, + Content => $args{Content}, + ); + + ok($t->id, "Created $args{Type} template"); + is($t->Name, $args{Name}, "$args{Type} template name"); + is($t->Content, $args{Content}, "$args{Type} content"); + is($t->Type, $args{Type}, "template type"); + + # this should never blow up! + my ($ok, $msg) = $t->CompileCheck; + + # we don't need to syntax check simple templates since if you mess them up + # it's safe to just use the input directly as the template's output + if ($args{SyntaxError} && $args{Type} eq 'Perl') { + ok(!$ok, "got a syntax error"); + } + else { + ok($ok, $msg); + } + + ($ok, $msg) = $t->Parse( + $args{'Arguments'} + ? ( %{ $args{'Arguments'} } ) + : (TicketObj => $ticket, TransactionObj => $txn ) + , + ); + if (defined $args{Output}) { + ok($ok, $msg); + is($t->MIMEObj->stringify_body, $args{Output}, "$args{Type} template's output"); + } + else { + ok(!$ok, "expected a failure"); + } +} + +sub TemplateTest { + local $Test::Builder::Level = $Test::Builder::Level + 1; + my %args = @_; + + for my $type ('Perl', 'Simple') { + IndividualTemplateTest( + %args, + Type => $type, + Output => $args{$type . 'Output'}, + ); + } +} + +sub SimpleTemplateTest { + local $Test::Builder::Level = $Test::Builder::Level + 1; + IndividualTemplateTest( @_, Type => 'Simple' ); +} + +sub PerlTemplateTest { + local $Test::Builder::Level = $Test::Builder::Level + 1; + IndividualTemplateTest( @_, Type => 'Perl' ); +} + diff --git a/rt/t/api/transaction.t b/rt/t/api/transaction.t new file mode 100644 index 000000000..22c3cfe72 --- /dev/null +++ b/rt/t/api/transaction.t @@ -0,0 +1,52 @@ + +use strict; +use warnings; +use RT; +use RT::Test tests => undef; +use Test::Warn; + +use_ok ('RT::Transaction'); + +{ + my $u = RT::User->new(RT->SystemUser); + $u->Load("root"); + ok ($u->Id, "Found the root user"); + ok(my $t = RT::Ticket->new(RT->SystemUser)); + my ($id, $msg) = $t->Create( Queue => 'General', + Subject => 'Testing', + Owner => $u->Id + ); + ok($id, "Create new ticket $id"); + isnt($id , 0); + + my $txn = RT::Transaction->new(RT->SystemUser); + my ($txn_id, $txn_msg) = $txn->Create( + Type => 'AddLink', + Field => 'RefersTo', + Ticket => $id, + NewValue => 'ticket 42', ); + ok( $txn_id, "Created transaction $txn_id: $txn_msg"); + + my $brief; + warning_like { $brief = $txn->BriefDescription } + qr/Could not determine a URI scheme/, + "Caught URI warning"; + + is( $brief, 'Reference to ticket 42 added', "Got string description: $brief"); + + $txn = RT::Transaction->new(RT->SystemUser); + ($txn_id, $txn_msg) = $txn->Create( + Type => 'DeleteLink', + Field => 'RefersTo', + Ticket => $id, + OldValue => 'ticket 42', ); + ok( $txn_id, "Created transaction $txn_id: $txn_msg"); + + warning_like { $brief = $txn->BriefDescription } + qr/Could not determine a URI scheme/, + "Caught URI warning"; + + is( $brief, 'Reference to ticket 42 deleted', "Got string description: $brief"); +} + +done_testing; diff --git a/rt/t/api/uri-canonicalize.t b/rt/t/api/uri-canonicalize.t new file mode 100644 index 000000000..288569c7f --- /dev/null +++ b/rt/t/api/uri-canonicalize.t @@ -0,0 +1,54 @@ +use strict; +use warnings; +use RT::Test tests => undef; + +my @warnings; +local $SIG{__WARN__} = sub { + push @warnings, "@_"; +}; + +# Create ticket +my $ticket = RT::Test->create_ticket( Queue => 1, Subject => 'test ticket' ); +ok $ticket->id, 'created ticket'; + +# Create article class +my $class = RT::Class->new( $RT::SystemUser ); +$class->Create( Name => 'URItest - '. $$ ); +ok $class->id, 'created a class'; + +# Create article +my $article = RT::Article->new( $RT::SystemUser ); +$article->Create( + Name => 'Testing URI parsing - '. $$, + Summary => 'In which this should load', + Class => $class->Id +); +ok $article->id, 'create article'; + +# Test permutations of URIs +my $ORG = RT->Config->Get('Organization'); +my $URI = RT::URI->new( RT->SystemUser ); +my %expected = ( + # tickets + "1" => "fsck.com-rt://$ORG/ticket/1", + "t:1" => "fsck.com-rt://$ORG/ticket/1", + "fsck.com-rt://$ORG/ticket/1" => "fsck.com-rt://$ORG/ticket/1", + + # articles + "a:1" => "fsck.com-article://$ORG/article/1", + "fsck.com-article://$ORG/article/1" => "fsck.com-article://$ORG/article/1", + + # random stuff + "http://$ORG" => "http://$ORG", + "mailto:foo\@example.com" => "mailto:foo\@example.com", + "invalid" => "invalid", # doesn't trigger die +); +for my $uri (sort keys %expected) { + is $URI->CanonicalizeURI($uri), $expected{$uri}, "canonicalized as expected"; +} + +is_deeply \@warnings, [ + "Could not determine a URI scheme for invalid\n", +], "expected warnings"; + +done_testing; diff --git a/rt/t/customfields/date.t b/rt/t/customfields/date.t new file mode 100644 index 000000000..475ace664 --- /dev/null +++ b/rt/t/customfields/date.t @@ -0,0 +1,86 @@ +use Test::MockTime qw(set_fixed_time restore_time); + +use warnings; +use strict; + +use RT::Test tests => undef; + +RT::Test->set_rights( + { Principal => 'Everyone', Right => [qw( + SeeQueue ShowTicket CreateTicket SeeCustomField ModifyCustomField + )] }, +); + +my $q = RT::Test->load_or_create_queue( Name => 'General' ); +ok $q && $q->id, 'loaded or created a queue'; + +my $user_m = RT::Test->load_or_create_user( Name => 'moscow', Timezone => 'Europe/Moscow' ); +ok $user_m && $user_m->id; + +my $user_b = RT::Test->load_or_create_user( Name => 'boston', Timezone => 'America/New_York' ); +ok $user_b && $user_b->id; + + +my $cf_name = 'A Date'; +my $cf; +{ + $cf = RT::CustomField->new(RT->SystemUser); + ok( + $cf->Create( + Name => $cf_name, + Type => 'Date', + MaxValues => 1, + LookupType => RT::Ticket->CustomFieldLookupType, + ), + 'create cf date' + ); + ok( $cf->AddToObject($q), 'date cf apply to queue' ); +} + +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_m ) ); + my ($id) = $ticket->Create( + Queue => $q->id, + Subject => 'Test', + 'CustomField-'. $cf->id => '2013-02-11', + ); + my $cf_value = $ticket->CustomFieldValues($cf_name)->First; + is( $cf_value->Content, '2013-02-11', 'correct value' ); + + $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_b ) ); + $ticket->Load($id); + is( $ticket->FirstCustomFieldValue($cf_name), '2013-02-11', 'correct value' ); +} + +{ + my $ticket = RT::Ticket->new(RT->SystemUser); + ok( + $ticket->Create( + Queue => $q->id, + Subject => 'Test', + 'CustomField-' . $cf->id => '2010-05-04 11:34:56', + ), + 'create ticket with cf set to 2010-05-04 11:34:56' + ); + is( $ticket->CustomFieldValues->First->Content, + '2010-05-04', 'date in db only has date' ); +} + +# in moscow it's already Feb 11, so tomorrow is Feb 12 +set_fixed_time("2013-02-10T23:10:00Z"); +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_m ) ); + my ($id) = $ticket->Create( + Queue => $q->id, + Subject => 'Test', + 'CustomField-'. $cf->id => 'tomorrow', + ); + my $cf_value = $ticket->CustomFieldValues($cf_name)->First; + is( $cf_value->Content, '2013-02-12', 'correct value' ); + + $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_b ) ); + $ticket->Load($id); + is( $ticket->FirstCustomFieldValue($cf_name), '2013-02-12', 'correct value' ); +} + +done_testing(); diff --git a/rt/t/customfields/datetime.t b/rt/t/customfields/datetime.t new file mode 100644 index 000000000..5e4497d0c --- /dev/null +++ b/rt/t/customfields/datetime.t @@ -0,0 +1,76 @@ +use Test::MockTime qw(set_fixed_time restore_time); + +use warnings; +use strict; + +use RT::Test tests => undef; + +RT::Test->set_rights( + { Principal => 'Everyone', Right => [qw( + SeeQueue ShowTicket CreateTicket SeeCustomField ModifyCustomField + )] }, +); + +my $q = RT::Test->load_or_create_queue( Name => 'General' ); +ok $q && $q->id, 'loaded or created a queue'; + +my $user_m = RT::Test->load_or_create_user( Name => 'moscow', Timezone => 'Europe/Moscow' ); +ok $user_m && $user_m->id; + +my $user_b = RT::Test->load_or_create_user( Name => 'boston', Timezone => 'America/New_York' ); +ok $user_b && $user_b->id; + + +my $cf_name = 'A Date and Time'; +my $cf; +{ + $cf = RT::CustomField->new(RT->SystemUser); + ok( + $cf->Create( + Name => $cf_name, + Type => 'DateTime', + MaxValues => 1, + LookupType => RT::Ticket->CustomFieldLookupType, + ), + 'create cf date' + ); + ok( $cf->AddToObject($q), 'date cf apply to queue' ); +} + +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_m ) ); + my ($id) = $ticket->Create( + Queue => $q->id, + Subject => 'Test', + 'CustomField-'. $cf->id => '2013-02-11 00:00:00', + ); + my $cf_value = $ticket->CustomFieldValues($cf_name)->First; + TODO: { + local $TODO = 'questionable result, should we change?'; + # $Ticket->Created returns UTC, not user's date, but + # ticket has ->CreatedObj method to get all required + # transformation + # No more TODO. + is( $cf_value->Content, '2013-02-11 00:00:00', 'correct value' ); + } + is( $cf_value->Content, '2013-02-10 20:00:00', 'correct value' ); + + $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_b ) ); + $ticket->Load($id); + is( $ticket->FirstCustomFieldValue($cf_name), '2013-02-10 20:00:00', 'correct value' ); +} + +# in moscow it's already Feb 11, so tomorrow is Feb 12 +set_fixed_time("2013-02-10T23:10:00Z"); +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user_m ) ); + my ($id) = $ticket->Create( + Queue => $q->id, + Subject => 'Test', + 'CustomField-'. $cf->id => 'tomorrow', + ); + my $cf_value = $ticket->CustomFieldValues($cf_name)->First; + is( $cf_value->Content, '2013-02-11 23:10:00', 'correct value' ); +} + +done_testing(); diff --git a/rt/t/customfields/iprangev6.t b/rt/t/customfields/iprangev6.t index 3b8a4d60a..84fec16a0 100644 --- a/rt/t/customfields/iprangev6.t +++ b/rt/t/customfields/iprangev6.t @@ -193,7 +193,7 @@ diag "check that we parse correct IPs only" if $ENV{'TEST_VERBOSE'}; } ); - $agent->content_like( qr/can not be parsed as an IP address range/, + $agent->content_like( qr/is not a valid IP address range/, 'ticket fails to create' ); } diff --git a/rt/t/customfields/repeated_values.t b/rt/t/customfields/repeated_values.t new file mode 100644 index 000000000..584512c7d --- /dev/null +++ b/rt/t/customfields/repeated_values.t @@ -0,0 +1,134 @@ +use warnings; +use strict; + +use RT::Test tests => undef; + + +my $ticket = RT::Test->create_ticket( Subject => 'test repeated values', Queue => 'General' ); +my ( $ret, $msg ); + +{ + diag "testing freeform single cf"; + my $freeform_single = RT::Test->load_or_create_custom_field( + Name => 'freeform single', + Type => 'FreeformSingle', + Queue => 0, + ); + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $freeform_single, Value => 'foo' ); + ok( $ret, $msg ); + is( $ticket->FirstCustomFieldValue($freeform_single), 'foo', 'value is foo' ); + + my $ocfv = $ticket->CustomFieldValues($freeform_single)->First; + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $freeform_single, Value => 'foo' ); + is( $ret, $ocfv->id, "got the same previous object" ); + is( $ticket->FirstCustomFieldValue($freeform_single), 'foo', 'value is still foo' ); + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $freeform_single, Value => 'FOO' ); + ok( $ret, $msg ); + isnt( $ret, $ocfv->id, "got a new value" ); + is( $ticket->FirstCustomFieldValue($freeform_single), 'FOO', 'value is FOO' ); +} + +{ + diag "testing freeform multiple cf"; + my $freeform_multiple = RT::Test->load_or_create_custom_field( + Name => 'freeform multiple', + Type => 'FreeformMultiple', + Queue => 0, + ); + + ($ret, $msg) = $ticket->AddCustomFieldValue( Field => $freeform_multiple, Value => 'foo' ); + ok($ret, $msg); + is( $ticket->FirstCustomFieldValue($freeform_multiple), 'foo', 'value is foo' ); + + my $ocfv = $ticket->CustomFieldValues($freeform_multiple)->First; + ($ret, $msg) = $ticket->AddCustomFieldValue( Field => $freeform_multiple, Value => 'foo' ); + is($ret, $ocfv->id, "got the same previous object"); + is( $ticket->FirstCustomFieldValue($freeform_multiple), 'foo', 'value is still foo' ); + + ($ret, $msg) = $ticket->AddCustomFieldValue( Field => $freeform_multiple, Value => 'bar' ); + ok($ret, $msg); + + my $ocfvs = $ticket->CustomFieldValues($freeform_multiple)->ItemsArrayRef; + is( scalar @$ocfvs, 2, 'has 2 values'); + is( $ocfvs->[0]->Content, 'foo', 'first is foo' ); + is( $ocfvs->[1]->Content, 'bar', 'sencond is bar' ); +} + +{ + diag "testing select single cf"; + + my $select_single = RT::Test->load_or_create_custom_field( + Name => 'select single', + Type => 'SelectSingle', + Queue => 0, + ); + + for my $value ( qw/foo bar baz/ ) { + $select_single->AddValue( Name => $value ); + } + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $select_single, Value => 'foo' ); + ok( $ret, $msg ); + my $ocfv = $ticket->CustomFieldValues($select_single)->First; + is( $ticket->FirstCustomFieldValue($select_single), 'foo', 'value is foo' ); + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $select_single, Value => 'foo' ); + is( $ret, $ocfv->id, "got the same previous object" ); + is( $ticket->FirstCustomFieldValue($select_single), 'foo', 'value is still foo' ); + + diag "select values are case insensitive"; + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $select_single, Value => 'FOO' ); + is( $ret, $ocfv->id, "got the same previous object" ); + is( $ticket->FirstCustomFieldValue($select_single), 'foo', 'value is still foo' ); + + ($ret, $msg) = $ticket->AddCustomFieldValue( Field => $select_single, Value => 'bar' ); + ok($ret, $msg); + isnt( $ret, $ocfv->id, "got a new value" ); + is( $ticket->FirstCustomFieldValue($select_single), 'bar', 'new value is bar' ); +} + +{ + diag "testing binary single cf"; + + my $binary_single = RT::Test->load_or_create_custom_field( + Name => 'upload single', + Type => 'BinarySingle', + Queue => 0, + ); + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $binary_single, Value => 'foo', LargeContent => 'bar' ); + ok( $ret, $msg ); + my $ocfv = $ticket->CustomFieldValues($binary_single)->First; + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $binary_single, Value => 'foo', LargeContent => 'bar' ); + is( $ret, $ocfv->id, "got the same previous object" ); + is($ocfv->Content, 'foo', 'name is foo'); + is($ocfv->LargeContent, 'bar', 'content is bar'); + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $binary_single, Value => 'foo', LargeContent => 'baz' ); + ok( $ret, $msg ); + isnt( $ret, $ocfv->id, "got a new value" ); + $ocfv = $ticket->CustomFieldValues($binary_single)->First; + is($ocfv->Content, 'foo', 'name is foo'); + is($ocfv->LargeContent, 'baz', 'content is baz'); + + ( $ret, $msg ) = + $ticket->AddCustomFieldValue( Field => $binary_single, Value => 'foo.2', LargeContent => 'baz' ); + ok( $ret, $msg ); + isnt( $ret, $ocfv->id, "got a new value" ); + $ocfv = $ticket->CustomFieldValues($binary_single)->First; + is($ocfv->Content, 'foo.2', 'name is foo.2'); + is($ocfv->LargeContent, 'baz', 'content is baz'); +} + +done_testing(); diff --git a/rt/t/data/configs/apache2.2+fastcgi.conf b/rt/t/data/configs/apache2.2+fastcgi.conf new file mode 100644 index 000000000..ab2613662 --- /dev/null +++ b/rt/t/data/configs/apache2.2+fastcgi.conf @@ -0,0 +1,50 @@ +ServerRoot %%SERVER_ROOT%% +PidFile %%PID_FILE%% +LockFile %%LOCK_FILE%% +ServerAdmin root@localhost + +%%LOAD_MODULES%% + +<IfModule !mpm_netware_module> +<IfModule !mpm_winnt_module> +User freeside +Group freeside +</IfModule> +</IfModule> + +ServerName localhost +Listen %%LISTEN%% + +ErrorLog "%%LOG_FILE%%" +LogLevel debug + +<Directory /> + Options FollowSymLinks + AllowOverride None + Order deny,allow + Deny from all +</Directory> + +AddDefaultCharset UTF-8 + +FastCgiServer %%RT_SBIN_PATH%%/rt-server.fcgi \ + -socket %%TMP_DIR%%/socket \ + -processes 1 \ + -idle-timeout 180 \ + -initial-env RT_SITE_CONFIG=%%RT_SITE_CONFIG%% \ + -initial-env RT_TESTING=1 + +Alias /NoAuth/images/ %%DOCUMENT_ROOT%%/NoAuth/images/ +ScriptAlias / %%RT_SBIN_PATH%%/rt-server.fcgi/ + +DocumentRoot "%%DOCUMENT_ROOT%%" +<Location /> + Order allow,deny + Allow from all + +%%BASIC_AUTH%% + + Options +ExecCGI + AddHandler fastcgi-script fcgi +</Location> + diff --git a/rt/t/data/configs/apache2.2+mod_perl.conf b/rt/t/data/configs/apache2.2+mod_perl.conf new file mode 100644 index 000000000..ae84c9d6b --- /dev/null +++ b/rt/t/data/configs/apache2.2+mod_perl.conf @@ -0,0 +1,67 @@ +<IfModule mpm_prefork_module> + StartServers 1 + MinSpareServers 1 + MaxSpareServers 1 + MaxClients 1 + MaxRequestsPerChild 0 +</IfModule> + +<IfModule mpm_worker_module> + StartServers 1 + MinSpareThreads 1 + MaxSpareThreads 1 + ThreadLimit 1 + ThreadsPerChild 1 + MaxClients 1 + MaxRequestsPerChild 0 +</IfModule> + +ServerRoot %%SERVER_ROOT%% +PidFile %%PID_FILE%% +LockFile %%LOCK_FILE%% +ServerAdmin root@localhost + +%%LOAD_MODULES%% + +<IfModule !mpm_netware_module> +<IfModule !mpm_winnt_module> +User freeside +Group freeside +</IfModule> +</IfModule> + +ServerName localhost +Listen %%LISTEN%% + +ErrorLog "%%LOG_FILE%%" +LogLevel debug + +<Directory /> + Options FollowSymLinks + AllowOverride None + Order deny,allow + Deny from all +</Directory> + +AddDefaultCharset UTF-8 +PerlSetEnv RT_SITE_CONFIG %%RT_SITE_CONFIG%% + +DocumentRoot "%%DOCUMENT_ROOT%%" +<Location /> + Order allow,deny + Allow from all + +%%BASIC_AUTH%% + + SetHandler modperl + + PerlResponseHandler Plack::Handler::Apache2 + PerlSetVar psgi_app %%RT_SBIN_PATH%%/rt-server +</Location> + +<Perl> + $ENV{RT_TESTING}=1; + use Plack::Handler::Apache2; + Plack::Handler::Apache2->preload("%%RT_SBIN_PATH%%/rt-server"); +</Perl> + diff --git a/rt/t/data/emails/text-html-in-russian b/rt/t/data/emails/text-html-in-russian deleted file mode 100755 index b965b1b59..000000000 --- a/rt/t/data/emails/text-html-in-russian +++ /dev/null @@ -1,87 +0,0 @@ -From rickt@other-example.com Tue Jun 17 20:39:13 2003 -Return-Path: <rickt@other-example.com> -X-Original-To: info -Delivered-To: mitya@vh.example.com -Received: from example.com (mx.example.com [194.87.0.32]) - by vh.example.com (Postfix) with ESMTP id 8D77B16E6BD - for <info>; Tue, 17 Jun 2003 20:39:05 +0400 (MSD) -Received: from hotline@example.com - by example.com (CommuniGate Pro GROUP 4.1b7/D) - with GROUP id 76033026; Tue, 17 Jun 2003 20:38:00 +0400 -Received: by example.com (CommuniGate Pro PIPE 4.1b7/D) - with PIPE id 76033052; Tue, 17 Jun 2003 20:38:00 +0400 -Received: from [217.132.49.75] (HELO compuserve.com) - by example.com (CommuniGate Pro SMTP 4.1b7/D) - with SMTP id 76032971 for info@example.com; Tue, 17 Jun 2003 20:37:41 +0400 -Date: Wed, 18 Jun 2003 01:41:01 +0000 -From: <rickt@other-example.com> -Subject: , YXLWLJ3LPT9UHuLyGTzyuKQc06eIZ96Y6RVTCZFt -To: Info <info@example.com> -References: <0ID97EGL951H1907@example.com> -In-Reply-To: <0ID97EGL951H1907@example.com> -Message-ID: <HDE46LIK8GGJJ72I@other-example.com> -MIME-Version: 1.0 -Content-Type: text/html; charset=Windows-1251 -Content-Transfer-Encoding: 8bit -X-Spam-Flag: YES -X-Spam-Checker-Version: SpamAssassin 2.60-cvs-jumbo.demos (1.190-2003-06-01-exp) -X-Spam-Level: ++++++++++++++ -X-Spam-Status: Yes, hits=14.9 required=5.0 tests=BAYES_99,DATE_IN_FUTURE_06_12 - FROM_ILLEGAL_CHARS,HTML_10_20,HTML_FONTCOLOR_UNKNOWN,HTML_FONT_BIG - MIME_HTML_ONLY,RCVD_IN_NJABL,SUBJ_HAS_SPACES,SUBJ_HAS_UNIQ_ID - SUBJ_ILLEGAL_CHARS autolearn=no version=2.60-cvs-jumbo.demos -X-Spam-Report: 14.9 points, 5.0 required; - * 2.3 -- Subject contains lots of white space - * 1.0 -- BODY: HTML font color is unknown to us - * 0.3 -- BODY: FONT Size +2 and up or 3 and up - [score: 1.0000] - * 2.8 -- BODY: Bayesian classifier spam probability is 99 to 100% - * 1.0 -- BODY: Message is 10% to 20% HTML - * 1.0 -- From contains too many raw illegal characters - * 1.0 -- Subject contains a unique ID - * 1.0 -- Subject contains too many raw illegal characters - * 1.2 -- Date: is 6 to 12 hours after Received: date - [217.132.49.75 listed in dnsbl.njabl.org] - * 1.2 -- RBL: Received via a relay in dnsbl.njabl.org - * 2.0 -- Message only has text/html MIME parts -Status: RO -Content-Length: 2743 -Lines: 36 - -<html><body><basefont face="times new roman, times, serif" size="2"> -<center>e ep " " paae a pe:<br> -<font size="5"><b> </b></font><br> -<font color="red"><b>19 2003 .</b></font><br> -<b><i>pe peaae ceo cpeeo paeecoo epcoaa.</i></b><br></center><br> -<p align="justify"><b>peep: opoo ae.</b> paec coo, o pao oee 10 e oac coo ec-peo. op pa a eoec oco pa apae coo, o ce: eoo eooo oe, e pe e epeoopo, pae oppoa opopaoo a p. ao ae coao coo, occc ae ocapceo c p peee , pc MBA.<br><br> -<b><u>e pea:</u></b><br> -1. co pe pae oae;<br> -2. o paece a oa epcoaa paoe;<br> -3. co ocoe a oaoopaoa;<br> -4. ae paec eoa coa ce paoe oa, oaoopaoa.<br><br> -<b><u>aa pea:</u></b><br> - - co eo oe p e oe opeeeo eeoc;<br> - - ac apa oe copo cooece c aaa opaa.<br><br> -<b><u>oepae popa:</u></b><br> -<b>I. aepae eaepae op oa:</b><br> -1. eco po oa pae epcoao;<br> -2. paa pae opaa.<br> -<b>II. paecoe peee oa pae epcoao:</b><br> -1. ope pacope;<br> -2. oa oea eeoc (po aeca copo);<br> -3. oa paa aaa.<br><br> -<b><u> aepe popa ac co:</u></b><br> -1. pepoa copo a ocee opeeeoo peaa;<br> -2. ae eoo aa pae oae epcoaa;<br> -3. pe oee a pae pae epcoao;<br> -4. pee ae ocoeoc (peoe) oa copo opaa.<br> -<i> oe pea coec pao cpao aepa o oa cpoa epcoaa poccc oa. o ooa aec cepa.</i><br><br> -<center>pooeoc: 1 e, 8 aco (a epepa, oe)<br> -<b>ooc ac: 4 700 pe e .</b><br> -921-5862, 928-4156, 928-4200, 928-5321</center><br> -<font size=1> c opa oooo poa ac e epece o p opoca - e: <a href="mailto:motiv@mailje.nl">seminar</a></font> -<br><font size="1" color="#ffffff">3ZkRPb60QBbiHef1IRVl</font> -</body></html> - - - diff --git a/rt/t/data/plugins/Overlays/html/overlay_loaded b/rt/t/data/plugins/Overlays/html/overlay_loaded new file mode 100644 index 000000000..eeeb0320f --- /dev/null +++ b/rt/t/data/plugins/Overlays/html/overlay_loaded @@ -0,0 +1,8 @@ +<%flags> +inherit => undef # avoid auth +</%flags> +<%init> +$r->content_type("text/plain"); +$m->out( $RT::User::LOADED_OVERLAY ? "yes" : "no" ); +$m->abort(200); +</%init> diff --git a/rt/t/data/plugins/Overlays/html/user_accessible b/rt/t/data/plugins/Overlays/html/user_accessible new file mode 100644 index 000000000..8eef2b437 --- /dev/null +++ b/rt/t/data/plugins/Overlays/html/user_accessible @@ -0,0 +1,8 @@ +<%flags> +inherit => undef # avoid auth +</%flags> +<%init> +$r->content_type("application/json"); +$m->out( JSON( RT::User->_ClassAccessible() ) ); +$m->abort(200); +</%init> diff --git a/rt/t/data/plugins/Overlays/lib/Overlays.pm b/rt/t/data/plugins/Overlays/lib/Overlays.pm new file mode 100644 index 000000000..f18b45877 --- /dev/null +++ b/rt/t/data/plugins/Overlays/lib/Overlays.pm @@ -0,0 +1,2 @@ +package Overlays; +1; diff --git a/rt/t/data/plugins/Overlays/lib/RT/User_Local.pm b/rt/t/data/plugins/Overlays/lib/RT/User_Local.pm new file mode 100644 index 000000000..312cc09f6 --- /dev/null +++ b/rt/t/data/plugins/Overlays/lib/RT/User_Local.pm @@ -0,0 +1,11 @@ +package RT::User; +use strict; +use warnings; + +our $LOADED_OVERLAY = 1; + +sub _LocalAccessible { + { Comments => { public => 1 } } +} + +1; diff --git a/rt/t/i18n/default.t b/rt/t/i18n/default.t index ea0848f54..d98828f0b 100644 --- a/rt/t/i18n/default.t +++ b/rt/t/i18n/default.t @@ -13,10 +13,10 @@ $m->content_contains('<html lang="en">'); $m->add_header('Accept-Language' => 'zh-tw,zh;q=0.8,en-gb;q=0.5,en;q=0.3'); $m->get_ok('/'); -use utf8; -Encode::_utf8_on($m->{content}); -$m->title_is('登入', 'Page title properly translated to chinese'); -$m->content_contains('密碼','Password properly translated'); +$m->title_is( Encode::decode("UTF-8",'登入'), + 'Page title properly translated to chinese'); +$m->content_contains( Encode::decode("UTF-8",'密碼'), + 'Password properly translated'); { local $TODO = "We fail to correctly advertise the langauage in the <html> block"; $m->content_contains('<html lang="zh-tw">'); diff --git a/rt/t/mail/charsets-outgoing.t b/rt/t/mail/charsets-outgoing.t index 2fc91f2e0..872721325 100644 --- a/rt/t/mail/charsets-outgoing.t +++ b/rt/t/mail/charsets-outgoing.t @@ -1,6 +1,5 @@ use strict; use warnings; -use Encode; use RT::Test tests => 78; @@ -72,7 +71,7 @@ foreach my $set ( 'ru', 'latin1' ) { my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$set}{test}/ or do { $status = 0; diag "wrong subject: $subject" }; } @@ -101,7 +100,7 @@ diag "ascii subject with non-ascii subject tag"; my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$tag_set}{support}/ or do { $status = 0; diag "wrong subject: $subject" }; } @@ -122,7 +121,7 @@ foreach my $set ( 'ru', 'latin1' ) { my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$tag_set}{support}/ or do { $status = 0; diag "wrong subject: $subject" }; $subject =~ /$string{$set}{test}/ @@ -171,7 +170,7 @@ diag "ascii subject with non-ascii subject prefix in template"; my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$prefix_set}{autoreply}/ or do { $status = 0; diag "wrong subject: $subject" }; } @@ -192,7 +191,7 @@ foreach my $set ( 'ru', 'latin1' ) { my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$prefix_set}{autoreply}/ or do { $status = 0; diag "wrong subject: $subject" }; $subject =~ /$string{$set}{test}/ @@ -222,7 +221,7 @@ foreach my $set ( 'ru', 'latin1' ) { my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$prefix_set}{autoreply}/ or do { $status = 0; diag "wrong subject: $subject" }; $subject =~ /$string{$tag_set}{support}/ @@ -275,7 +274,7 @@ foreach my $set ( 'ru', 'latin1' ) { my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$set}{test}/ or do { $status = 0; diag "wrong subject: $subject" }; } @@ -303,7 +302,7 @@ foreach my $set ( 'ru', 'latin1' ) { my $status = 1; foreach my $mail ( @mails ) { my $entity = parse_mail( $mail ); - my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') ); $subject =~ /$string{$set}{test}/ or do { $status = 0; diag "wrong subject: $subject" }; $subject =~ /$string{$tag_set}{support}/ diff --git a/rt/t/mail/dashboard-chart-with-utf8.t b/rt/t/mail/dashboard-chart-with-utf8.t index 79f5f0e11..37f8ce0c6 100644 --- a/rt/t/mail/dashboard-chart-with-utf8.t +++ b/rt/t/mail/dashboard-chart-with-utf8.t @@ -12,8 +12,6 @@ BEGIN { } } -use utf8; - my $root = RT::Test->load_or_create_user( Name => 'root' ); my ( $baseurl, $m ) = RT::Test->started_ok; @@ -21,11 +19,11 @@ ok( $m->login, 'logged in' ); my $ticket = RT::Ticket->new( $RT::SystemUser ); $ticket->Create( Queue => 'General', - Subject => 'test äöü', + Subject => Encode::decode("UTF-8",'test äöü'), ); ok( $ticket->id, 'created ticket' ); -$m->get_ok(q{/Search/Chart.html?Query=Subject LIKE 'test äöü'}); +$m->get_ok(Encode::decode("UTF-8", q{/Search/Chart.html?Query=Subject LIKE 'test äöü'})); $m->submit_form( form_name => 'SaveSearch', fields => { @@ -58,7 +56,7 @@ $m->field( 'Hour' => '06:00' ); $m->click_button( name => 'Save' ); $m->content_contains('Subscribed to dashboard dashboard foo'); -my $c = $m->get(q{/Search/Chart?Query=Subject LIKE 'test äöü'}); +my $c = $m->get(Encode::decode("UTF-8",q{/Search/Chart?Query=Subject LIKE 'test äöü'})); my $image = $c->content; RT::Test->run_and_capture( command => $RT::SbinPath . '/rt-email-dashboards', all => 1 diff --git a/rt/t/mail/extractsubjecttag.t b/rt/t/mail/extractsubjecttag.t index 14fab44b5..1aadaa7b7 100644 --- a/rt/t/mail/extractsubjecttag.t +++ b/rt/t/mail/extractsubjecttag.t @@ -1,6 +1,5 @@ use strict; use warnings; -use utf8; use RT::Test tests => 18; diff --git a/rt/t/mail/gateway.t b/rt/t/mail/gateway.t index 9482ffcb2..4f906c89c 100644 --- a/rt/t/mail/gateway.t +++ b/rt/t/mail/gateway.t @@ -504,8 +504,7 @@ EOF is ($tick->Id, $id, "correct ticket"); is ($tick->Subject , 'This is a test of I18N ticket creation', "Created the ticket - ". $tick->Subject); - my $unistring = "\303\241\303\251\303\255\303\263\303\272"; - Encode::_utf8_on($unistring); + my $unistring = Encode::decode("UTF-8","\303\241\303\251\303\255\303\263\303\272"); is ( $tick->Transactions->First->Content, $tick->Transactions->First->Attachments->First->Content, @@ -542,8 +541,7 @@ EOF is ($tick->Id, $id, "correct ticket"); is ($tick->Subject , 'This is a test of I18N ticket creation', "Created the ticket"); - my $unistring = "\303\241\303\251\303\255\303\263\303\272"; - Encode::_utf8_on($unistring); + my $unistring = Encode::decode("UTF-8","\303\241\303\251\303\255\303\263\303\272"); ok ( $tick->Transactions->First->Content =~ $unistring, @@ -573,8 +571,7 @@ EOF my $tick = RT::Test->last_ticket; is ($tick->Id, $id, "correct ticket"); - my $content = $tick->Transactions->First->Content; - Encode::_utf8_off($content); + my $content = Encode::encode("UTF-8",$tick->Transactions->First->Content); like $content, qr{informaci\303\263n confidencial}; like $content, qr{informaci\357\277\275n confidencial}; diff --git a/rt/t/mail/header-characters.t b/rt/t/mail/header-characters.t new file mode 100644 index 000000000..004ba8522 --- /dev/null +++ b/rt/t/mail/header-characters.t @@ -0,0 +1,81 @@ +use strict; +use warnings; + +use RT::Test tests => 12; +use Test::Warn; + +my ($baseurl, $m) = RT::Test->started_ok; + +diag "Testing non-ASCII in From: header"; +SKIP:{ + skip "Test requires Email::Address 1.893 or later, " + . "you have $Email::Address::VERSION", 3, + if $Email::Address::VERSION < 1.893; + + my $mail = Encode::encode( 'iso-8859-1', Encode::decode( "UTF-8", <<'.') ); +From: René@example.com> +Reply-To: =?iso-8859-1?Q?Ren=E9?= <René@example.com> +Subject: testing non-ASCII From +Content-Type: text/plain; charset=iso-8859-1 + +here's some content +. + + my ($status, $id); + warnings_like { ( $status, $id ) = RT::Test->send_via_mailgate($mail) } + [qr/Failed to parse Reply-To:.*, From:/, + qr/Couldn't parse or find sender's address/ + ], + 'Got parse error for non-ASCII in From'; + is( $status >> 8, 0, "The mail gateway exited normally" ); + TODO: { + local $TODO = "Currently don't handle non-ASCII for sender"; + ok( $id, "Created ticket" ); + } +} + +diag "Testing iso-8859-1 encoded non-ASCII in From: header"; +SKIP:{ + skip "Test requires Email::Address 1.893 or later, " + . "you have $Email::Address::VERSION", 3, + if $Email::Address::VERSION < 1.893; + + my $mail = Encode::encode( 'iso-8859-1', Encode::decode( "UTF-8", <<'.' ) ); +From: =?iso-8859-1?Q?Ren=E9?= <René@example.com> +Reply-To: =?iso-8859-1?Q?Ren=E9?= <René@example.com> +Subject: testing non-ASCII From +Content-Type: text/plain; charset=iso-8859-1 + +here's some content +. + + my ($status, $id); + warnings_like { ( $status, $id ) = RT::Test->send_via_mailgate($mail) } + [qr/Failed to parse Reply-To:.*, From:/, + qr/Couldn't parse or find sender's address/ + ], + 'Got parse error for iso-8859-1 in From'; + is( $status >> 8, 0, "The mail gateway exited normally" ); + TODO: { + local $TODO = "Currently don't handle non-ASCII in sender"; + ok( $id, "Created ticket" ); + } +} + +diag "No sender"; +{ + my $mail = <<'.'; +To: rt@example.com +Subject: testing non-ASCII From +Content-Type: text/plain; charset=iso-8859-1 + +here's some content +. + + my ($status, $id); + warnings_like { ( $status, $id ) = RT::Test->send_via_mailgate($mail) } + [qr/Couldn't parse or find sender's address/], + 'Got parse error with no sender fields'; + is( $status >> 8, 0, "The mail gateway exited normally" ); + ok( !$id, "No ticket created" ); +} diff --git a/rt/t/mail/not-supported-charset.t b/rt/t/mail/not-supported-charset.t new file mode 100644 index 000000000..bf2fe8f05 --- /dev/null +++ b/rt/t/mail/not-supported-charset.t @@ -0,0 +1,69 @@ +use strict; +use warnings; + +use RT::Test tests => undef; +use Test::Warn; + +my $queue = RT::Test->load_or_create_queue( Name => 'General' ); +ok $queue->id, 'loaded queue'; + +{ + my $mail = <<'END'; +From: root@localhost +Subject: test +Content-type: text/plain; charset="not-supported-encoding" + +ho hum just some text + +END + + my ($stat, $id); + warning_like { + ($stat, $id) = RT::Test->send_via_mailgate($mail); + is( $stat >> 8, 0, "The mail gateway exited normally" ); + ok( $id, "created ticket" ); + } qr/Encoding 'not-supported-encoding' is not supported/; + + my $ticket = RT::Ticket->new( RT->SystemUser ); + $ticket->Load($id); + ok $ticket->id, "loaded ticket"; + + my $txn = $ticket->Transactions->First; + ok !$txn->ContentObj, 'no content'; + + my $attach = $txn->Attachments->First; + like $attach->Content, qr{ho hum just some text}, 'attachment is there'; + is $attach->GetHeader('Content-Type'), + 'application/octet-stream; charset="not-supported-encoding"', + 'content type is changed' + ; + is $attach->GetHeader('X-RT-Original-Content-Type'), + 'text/plain', + 'original content type is saved' + ; +} + +{ + my $mail = <<'END'; +From: root@localhost +Subject: =?not-supported?Q?=07test=A9?= +Content-type: text/plain; charset="ascii" + +ho hum just some text + +END + + my ($stat, $id); + warning_like { + ($stat, $id) = RT::Test->send_via_mailgate($mail); + is( $stat >> 8, 0, "The mail gateway exited normally" ); + ok( $id, "created ticket" ); + } qr/Charset 'not-supported' is not supported/; + + my $ticket = RT::Ticket->new( RT->SystemUser ); + $ticket->Load($id); + ok $ticket->id, "loaded ticket"; + is $ticket->Subject, "\x{FFFD}test\x{FFFD}"; +} + +done_testing; diff --git a/rt/t/mail/one-time-recipients.t b/rt/t/mail/one-time-recipients.t index 3484d1470..a9881cded 100644 --- a/rt/t/mail/one-time-recipients.t +++ b/rt/t/mail/one-time-recipients.t @@ -1,6 +1,5 @@ use strict; use warnings; -use utf8; use RT::Test tests => 38; diff --git a/rt/t/mail/rfc2231-attachment.t b/rt/t/mail/rfc2231-attachment.t index fc74c4720..9610961f0 100644 --- a/rt/t/mail/rfc2231-attachment.t +++ b/rt/t/mail/rfc2231-attachment.t @@ -1,7 +1,6 @@ use strict; use warnings; -use utf8; use RT::Test tests => undef; my ($baseurl, $m) = RT::Test->started_ok; ok $m->login, 'logged in as root'; @@ -20,7 +19,7 @@ diag "encoded attachment filename with parameter continuations"; ok( $id, "Created ticket" ); $m->get_ok("/Ticket/Display.html?id=$id"); - $m->content_contains("新しいテキスト ドキュメント.txt", "found full filename"); + $m->content_contains(Encode::decode("UTF-8","新しいテキスト ドキュメント.txt"), "found full filename"); } undef $m; diff --git a/rt/t/mail/sendmail.t b/rt/t/mail/sendmail.t index 44903f375..56202ad5d 100644 --- a/rt/t/mail/sendmail.t +++ b/rt/t/mail/sendmail.t @@ -1,546 +1,150 @@ use strict; use warnings; -use File::Spec (); - -use RT::Test tests => 141; -use RT::EmailParser; -use RT::Tickets; -use RT::Action::SendEmail; +use RT::Test tests => undef; -my @_outgoing_messages; -my @scrips_fired; +use File::Spec (); +use Email::Abstract; -#We're not testing acls here. +# We're not testing acls here. my $everyone = RT::Group->new(RT->SystemUser); $everyone->LoadSystemInternalGroup('Everyone'); $everyone->PrincipalObj->GrantRight( Right =>'SuperUser' ); - -is (__PACKAGE__, 'main', "We're operating in the main package"); - -{ - no warnings qw/redefine/; - *RT::Action::SendEmail::SendMessage = sub { - my $self = shift; - my $MIME = shift; - - main::_fired_scrip($self->ScripObj); - main::is(ref($MIME) , 'MIME::Entity', "hey, look. it's a mime entity"); - }; -} - # some utils sub first_txn { return $_[0]->Transactions->First } sub first_attach { return first_txn($_[0])->Attachments->First } - -sub count_txns { return $_[0]->Transactions->Count } sub count_attachs { return first_txn($_[0])->Attachments->Count } -# instrument SendEmail to pass us what it's about to send. -# create a regular ticket - -my $parser = RT::EmailParser->new(); - -# Let's test to make sure a multipart/report is processed correctly -my $multipart_report_email = RT::Test::get_relocatable_file('multipart-report', - (File::Spec->updir(), 'data', 'emails')); -my $content = RT::Test->file_content($multipart_report_email); -# be as much like the mail gateway as possible. -use RT::Interface::Email; -my %args = (message => $content, queue => 1, action => 'correspond'); -my ($status, $msg) = RT::Interface::Email::Gateway(\%args); -ok($status, "successfuly used Email::Gateway interface") or diag("error: $msg"); -my $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -my $tick= $tickets->First(); -isa_ok($tick, "RT::Ticket", "got a ticket object"); -ok ($tick->Id, "found ticket ".$tick->Id); -like (first_txn($tick)->Content , qr/The original message was received/, "It's the bounce"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); - -undef @scrips_fired; - - - - -$parser->ParseMIMEEntityFromScalar('From: root@localhost -To: rt@example.com -Subject: This is a test of new ticket creation as an unknown user - -Blah! -Foob!'); - - -use Data::Dumper; - -my $ticket = RT::Ticket->new(RT->SystemUser); -my ($id, undef, $create_msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity); -ok ($id,$create_msg); -$tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); -is ($tick->Subject , 'I18NTest', "failed to create the new ticket from an unprivileged account"); - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply -# make sure it sends a notification to adminccs - - -# we need to swap out SendMessage to test the new things we care about; -&utf8_redef_sendmessage; - -# create an iso 8859-1 ticket -@scrips_fired = (); - -my $iso_8859_1_ticket_email = RT::Test::get_relocatable_file( - 'new-ticket-from-iso-8859-1', (File::Spec->updir(), 'data', 'emails')); -$content = RT::Test->file_content($iso_8859_1_ticket_email); - - - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -use RT::Interface::Email; - - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -like (first_txn($tick)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply - - -# make sure it sends a notification to adminccs - -# If we correspond, does it do the right thing to the outbound messages? - -$parser->ParseMIMEEntityFromScalar($content); - ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity); -ok ($id, $msg); - -$parser->ParseMIMEEntityFromScalar($content); -($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity); -ok ($id, $msg); - - - - - -# we need to swap out SendMessage to test the new things we care about; -&iso8859_redef_sendmessage; -RT->Config->Set( EmailOutputEncoding => 'iso-8859-1' ); -# create an iso 8859-1 ticket -@scrips_fired = (); - - $content = RT::Test->file_content($iso_8859_1_ticket_email); -# be as much like the mail gateway as possible. -use RT::Interface::Email; - - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); -$tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -like (first_txn($tick)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply - - -# make sure it sends a notification to adminccs - - -# If we correspond, does it do the right thing to the outbound messages? - -$parser->ParseMIMEEntityFromScalar($content); - ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity); -ok ($id, $msg); - -$parser->ParseMIMEEntityFromScalar($content); -($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity); -ok ($id, $msg); - - -sub _fired_scrip { - my $scrip = shift; - push @scrips_fired, $scrip; -} +sub mail_in_ticket { + my ($filename) = @_; + my $path = RT::Test::get_relocatable_file($filename, + (File::Spec->updir(), 'data', 'emails')); + my $content = RT::Test->file_content($path); -sub utf8_redef_sendmessage { - no warnings qw/redefine/; - *RT::Action::SendEmail::SendMessage = sub { - my $self = shift; - my $MIME = shift; + RT::Test->clean_caught_mails; + my ($status, $id) = RT::Test->send_via_mailgate( $content ); + ok( $status, "Fed $filename into mailgate"); - my $scrip = $self->ScripObj->id; - ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name); - main::_fired_scrip($self->ScripObj); - $MIME->make_singlepart; - main::is( ref($MIME) , 'MIME::Entity', - "hey, look. it's a mime entity" ); - main::is( ref( $MIME->head ) , 'MIME::Head', - "its mime header is a mime header. yay" ); - main::like( $MIME->head->get('Content-Type') , qr/utf-8/, - "Its content type is utf-8" ); - my $message_as_string = $MIME->bodyhandle->as_string(); - use Encode; - $message_as_string = Encode::decode_utf8($message_as_string); - main::like( - $message_as_string , qr/H\x{e5}vard/, -"The message's content contains havard's name. this will fail if it's not utf8 out"); + my $ticket = RT::Ticket->new(RT->SystemUser); + $ticket->Load($id); + ok( $ticket->Id, "Successfully created ticket ".$ticket->Id); - }; + my @mail = map {Email::Abstract->new($_)->cast('MIME::Entity')} + RT::Test->fetch_caught_mails; + return ($ticket, @mail); } -sub iso8859_redef_sendmessage { - no warnings qw/redefine/; - *RT::Action::SendEmail::SendMessage = sub { - my $self = shift; - my $MIME = shift; - - my $scrip = $self->ScripObj->id; - ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name); - main::_fired_scrip($self->ScripObj); - $MIME->make_singlepart; - main::is( ref($MIME) , 'MIME::Entity', - "hey, look. it's a mime entity" ); - main::is( ref( $MIME->head ) , 'MIME::Head', - "its mime header is a mime header. yay" ); - main::like( $MIME->head->get('Content-Type') , qr/iso-8859-1/, - "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") ); - my $message_as_string = $MIME->bodyhandle->as_string(); - use Encode; - $message_as_string = Encode::decode("iso-8859-1",$message_as_string); - main::like( - $message_as_string , qr/H\x{e5}vard/, "The message's content contains havard's name. this will fail if it's not utf8 out"); - }; +{ + my ($ticket) = mail_in_ticket('multipart-report'); + like( first_txn($ticket)->Content , qr/The original message was received/, "It's the bounce"); } +for my $encoding ('ISO-8859-1', 'UTF-8') { + RT->Config->Set( EmailOutputEncoding => $encoding ); - my $alt_umlaut_email = RT::Test::get_relocatable_file( - 'multipart-alternative-with-umlaut', (File::Spec->updir(), 'data', 'emails')); - $content = RT::Test->file_content($alt_umlaut_email); - -$parser->ParseMIMEEntityFromScalar($content); + my ($ticket, @mail) = mail_in_ticket('new-ticket-from-iso-8859-1'); + like (first_txn($ticket)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay"); + is(@mail, 1); + like( $mail[0]->head->get('Content-Type') , qr/$encoding/, + "Its content type is $encoding" ); + my $message_as_string = $mail[0]->bodyhandle->as_string(); + $message_as_string = Encode::decode($encoding, $message_as_string); + like( $message_as_string , qr/H\x{e5}vard/, + "The message's content contains havard's name in $encoding"); +} -# be as much like the mail gateway as possible. { - no warnings qw/redefine/; - local *RT::Action::SendEmail::SendMessage = sub { return 1}; - - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - # TODO: following 5 lines should replaced by get_latest_ticket_ok() - $tickets = RT::Tickets->new(RT->SystemUser); - $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); - $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick = $tickets->First(); - - ok ($tick->Id, "found ticket ".$tick->Id); - - like (first_txn($tick)->Content , qr/causes Error/, "We recorded the content right as text-plain"); - is (count_attachs($tick) , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative"); - + my ($ticket) = mail_in_ticket('multipart-alternative-with-umlaut'); + like( first_txn($ticket)->Content, qr/causes Error/, + "We recorded the content as containing 'causes error'"); + is( count_attachs($ticket), 3, + "Has three attachments, presumably a text-plain, a text-html and a multipart alternative"); } - - my $text_html_email = RT::Test::get_relocatable_file('text-html-with-umlaut', - (File::Spec->updir(), 'data', 'emails')); - $content = RT::Test->file_content($text_html_email); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_html_redef_sendmessage; - - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -like (first_attach($tick)->Content , qr/causes Error/, "We recorded the content as containing 'causes error'") or diag( first_attach($tick)->Content ); -like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the content as text/html"); -is (count_attachs($tick), 1 , "Has one attachment, presumably a text-html and a multipart alternative"); - -sub text_html_redef_sendmessage { - no warnings qw/redefine/; - *RT::Action::SendEmail::SendMessage = sub { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->parts, 0, "generated correspondence mime entity - does not have parts"); - is ($MIME->head->mime_type , "text/plain", "The mime type is a plain"); - }; +{ + my ($ticket, @mail) = mail_in_ticket('text-html-with-umlaut'); + like( first_attach($ticket)->Content, qr/causes Error/, + "We recorded the content as containing 'causes error'"); + like( first_attach($ticket)->ContentType , qr/text\/html/, + "We recorded the content as text/html"); + is (count_attachs($ticket), 1, + "Has one attachment, just a text-html"); + + is(@mail, 1); + is( $mail[0]->parts, 0, "generated correspondence mime entity does not have parts"); + is( $mail[0]->head->mime_type , "text/plain", "The mime type is a plain"); } - - my $russian_email = RT::Test::get_relocatable_file('text-html-in-russian', - (File::Spec->updir(), 'data', 'emails')); - $content = RT::Test->file_content($russian_email); - -$parser->ParseMIMEEntityFromScalar($content); - -# be as much like the mail gateway as possible. -&text_html_redef_sendmessage; - - %args = (message => $content, queue => 1, action => 'correspond'); - { - -my @warnings; -local $SIG{__WARN__} = sub { - push @warnings, "@_"; -}; - -RT::Interface::Email::Gateway(\%args); - -TODO: { - local $TODO = -'need a better approach of encoding converter, should be fixed in 4.2'; -ok( @warnings == 1 || @warnings == 2, "1 or 2 warnings are ok" ); -ok( @warnings == 1 || ( @warnings == 2 && $warnings[1] eq $warnings[0] ), - 'if there are 2 warnings, they should be same' ); - -like( - $warnings[0], - qr/\QEncoding error: "\x{041f}" does not map to iso-8859-1/, -"The badly formed Russian spam we have isn't actually well-formed UTF8, which makes Encode (correctly) warn", -); - -} + my @InputEncodings = RT->Config->Get('EmailInputEncodings'); + RT->Config->Set( EmailInputEncodings => 'koi8-r', @InputEncodings ); + RT->Config->Set( EmailOutputEncoding => 'koi8-r' ); + + my ($ticket, @mail) = mail_in_ticket('russian-subject-no-content-type'); + like( first_attach($ticket)->ContentType, qr/text\/plain/, + "We recorded the content type right"); + is( count_attachs($ticket), 1, + "Has one attachment, presumably a text-plain"); + is( $ticket->Subject, Encode::decode("UTF-8","тест тест"), + "Recorded the subject right"); + + is(@mail, 1); + is( $mail[0]->head->mime_type , "text/plain", "The only part is text/plain "); + like( $mail[0]->head->get("subject"), qr/\Q=?KOI8-R?B?W2V4YW1wbGUuY29tICM2XSBBdXRvUmVwbHk6INTF09Qg1MXT1A==?=\E/, + "The subject is encoded correctly"); + + RT->Config->Set(EmailInputEncodings => @InputEncodings ); + RT->Config->Set(EmailOutputEncoding => 'utf-8'); } - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the content right as text-html"); - -is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-html and a multipart alternative"); - - - -RT->Config->Set( EmailInputEncodings => 'koi8-r', RT->Config->Get('EmailInputEncodings') ); -RT->Config->Set( EmailOutputEncoding => 'koi8-r' ); -my $russian_subject_email = RT::Test::get_relocatable_file( - 'russian-subject-no-content-type', (File::Spec->updir(), 'data', 'emails')); -$content = RT::Test->file_content($russian_subject_email); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_plain_russian_redef_sendmessage; - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -$tick= $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -like (first_attach($tick)->ContentType , qr/text\/plain/, "We recorded the content type right"); -is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-plain"); -is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right"); -sub text_plain_russian_redef_sendmessage { - no warnings qw/redefine/; - *RT::Action::SendEmail::SendMessage = sub { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "text/plain", "The only part is text/plain "); - my $subject = $MIME->head->get("subject"); - chomp($subject); - #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly"); - }; +{ + my ($ticket, @mail) = mail_in_ticket('nested-rfc-822'); + is( $ticket->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?"); + like( first_attach($ticket)->ContentType, qr/multipart\/mixed/, + "We recorded the content type right"); + is( count_attachs($ticket), 5, + "Has five attachments, presumably a text-plain and a message RFC 822 and another plain"); + + is(@mail, 1); + is( $mail[0]->head->mime_type , "text/plain", "The outgoing mail is plain text"); + + my $encoded_subject = $mail[0]->head->get("Subject"); + chomp $encoded_subject; + my $subject = Encode::decode('MIME-Header',$encoded_subject); + like($subject, qr/Niv\x{e5}er/, "The subject matches the word - $subject"); } -my @input_encodings = RT->Config->Get( 'EmailInputEncodings' ); -shift @input_encodings; -RT->Config->Set(EmailInputEncodings => @input_encodings ); -RT->Config->Set(EmailOutputEncoding => 'utf-8'); - - - -my $nested_rfc822_email = RT::Test::get_relocatable_file('nested-rfc-822', - (File::Spec->updir(), 'data', 'emails')); -$content = RT::Test->file_content($nested_rfc822_email); -ok ($content, "Loaded nested-rfc-822 to test"); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_plain_nested_redef_sendmessage; - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -$tick= $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); -is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?"); -like (first_attach($tick)->ContentType , qr/multipart\/mixed/, "We recorded the content type right"); -is (count_attachs($tick) , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain"); -sub text_plain_nested_redef_sendmessage { - no warnings qw/redefine/; - *RT::Action::SendEmail::SendMessage = sub { - my $self = shift; - my $MIME = shift; - - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - - is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart"); - - use MIME::Words qw(:all); - my $encoded_subject = $MIME->head->get("subject"); - my $subject = decode_mimewords($encoded_subject); - - # MIME::Words isn't actually UTF8-safe. There go 4 hours I'll never get back. - utf8::decode($subject); - like($subject, qr/Niv\x{e5}er/, "The subject matches the word - $subject"); - - 1; - }; +{ + my ($ticket) = mail_in_ticket('notes-uuencoded'); + like( first_txn($ticket)->Content, qr/from Lotus Notes/, + "We recorded the content right"); + is( count_attachs($ticket), 3, "Has three attachments"); } - - - - my $uuencoded_email = RT::Test::get_relocatable_file('notes-uuencoded', - (File::Spec->updir(), 'data', 'emails')); - $content = RT::Test->file_content($uuencoded_email); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. { - no warnings qw/redefine/; - local *RT::Action::SendEmail::SendMessage = sub { return 1}; - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); - $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); - $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); - $tick= $tickets->First(); - ok ($tick->Id, "found ticket ".$tick->Id); - - like (first_txn($tick)->Content , qr/from Lotus Notes/, "We recorded the content right"); - is (count_attachs($tick) , 3 , "Has three attachments"); + my ($ticket) = mail_in_ticket('crashes-file-based-parser'); + like( first_txn($ticket)->Content, qr/FYI/, "We recorded the content right"); + is( count_attachs($ticket), 5, "Has five attachments"); } +{ + my ($ticket) = mail_in_ticket('rt-send-cc'); + my $cc = first_attach($ticket)->GetHeader('RT-Send-Cc'); + like ($cc, qr/test$_/, "Found test $_") for 1..5; +} - - my $crashes_file_based_parser_email = RT::Test::get_relocatable_file( - 'crashes-file-based-parser', (File::Spec->updir(), 'data', 'emails')); - $content = RT::Test->file_content($crashes_file_based_parser_email); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. - -no warnings qw/redefine/; -local *RT::Action::SendEmail::SendMessage = sub { return 1}; - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -$tick= $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -like (first_txn($tick)->Content , qr/FYI/, "We recorded the content right"); -is (count_attachs($tick) , 5 , "Has three attachments"); - - - - - - - my $rt_send_cc_email = RT::Test::get_relocatable_file('rt-send-cc', - (File::Spec->updir(), 'data', 'emails')); - $content = RT::Test->file_content($rt_send_cc_email); - -$parser->ParseMIMEEntityFromScalar($content); - - - - %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new(RT->SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -$tick= $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -my $cc = first_attach($tick)->GetHeader('RT-Send-Cc'); -like ($cc , qr/test1/, "Found test 1"); -like ($cc , qr/test2/, "Found test 2"); -like ($cc , qr/test3/, "Found test 3"); -like ($cc , qr/test4/, "Found test 4"); -like ($cc , qr/test5/, "Found test 5"); - - -diag q{regression test for #5248 from rt3.fsck.com}; { - my $subject_folding_email = RT::Test::get_relocatable_file( - 'subject-with-folding-ws', (File::Spec->updir(), 'data', 'emails')); - my $content = RT::Test->file_content($subject_folding_email); - my ($status, $msg, $ticket) = RT::Interface::Email::Gateway( - { message => $content, queue => 1, action => 'correspond' } - ); - ok ($status, 'created ticket') or diag "error: $msg"; - ok ($ticket->id, "found ticket ". $ticket->id); + diag "Regression test for #5248 from rt3.fsck.com"; + my ($ticket) = mail_in_ticket('subject-with-folding-ws'); is ($ticket->Subject, 'test', 'correct subject'); } -diag q{regression test for #5248 from rt3.fsck.com}; { - my $long_subject_email = RT::Test::get_relocatable_file('very-long-subject', - (File::Spec->updir(), 'data', 'emails')); - my $content = RT::Test->file_content($long_subject_email); - my ($status, $msg, $ticket) = RT::Interface::Email::Gateway( - { message => $content, queue => 1, action => 'correspond' } - ); - ok ($status, 'created ticket') or diag "error: $msg"; - ok ($ticket->id, "found ticket ". $ticket->id); + diag "Regression test for #5248 from rt3.fsck.com"; + my ($ticket) = mail_in_ticket('very-long-subject'); is ($ticket->Subject, '0123456789'x20, 'correct subject'); } - - -# Don't taint the environment -$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser'); +done_testing; diff --git a/rt/t/mail/threading.t b/rt/t/mail/threading.t index 773b7207f..9d3a07751 100644 --- a/rt/t/mail/threading.t +++ b/rt/t/mail/threading.t @@ -1,6 +1,5 @@ use strict; use warnings; -use utf8; use RT::Test tests => 22; RT->Config->Set( NotifyActor => 1 ); diff --git a/rt/t/mail/wrong_mime_charset.t b/rt/t/mail/wrong_mime_charset.t index 530b5f38d..6bbaca1bb 100644 --- a/rt/t/mail/wrong_mime_charset.t +++ b/rt/t/mail/wrong_mime_charset.t @@ -3,10 +3,8 @@ use warnings; use RT::Test nodb => 1, tests => 6; use_ok('RT::I18N'); -use utf8; -use Encode; -my $test_string = 'À'; -my $encoded_string = encode( 'iso-8859-1', $test_string ); +my $test_string = Encode::decode("UTF-8", 'À'); +my $encoded_string = Encode::encode( 'iso-8859-1', $test_string ); my $mime = MIME::Entity->build( "Subject" => $encoded_string, "Data" => [$encoded_string], @@ -40,10 +38,10 @@ like( "We can't encode something into the wrong encoding without Encode complaining" ); -my $subject = decode( 'iso-8859-1', $mime->head->get('Subject') ); +my $subject = Encode::decode( 'iso-8859-1', $mime->head->get('Subject') ); chomp $subject; is( $subject, $test_string, 'subject is set to iso-8859-1' ); -my $body = decode( 'iso-8859-1', $mime->stringify_body ); +my $body = Encode::decode( 'iso-8859-1', $mime->stringify_body ); chomp $body; is( $body, $test_string, 'body is set to iso-8859-1' ); } diff --git a/rt/t/security/CVE-2011-2083-cf-urls.t b/rt/t/security/CVE-2011-2083-cf-urls.t new file mode 100644 index 000000000..b1e1f3b0f --- /dev/null +++ b/rt/t/security/CVE-2011-2083-cf-urls.t @@ -0,0 +1,48 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my ($base, $m) = RT::Test->started_ok; + +my $link = RT::Test->load_or_create_custom_field( + Name => 'link', + Type => 'Freeform', + MaxValues => 1, + Queue => 0, + LinkValueTo => '__CustomField__', +); + +my $include = RT::Test->load_or_create_custom_field( + Name => 'include', + Type => 'Freeform', + MaxValues => 1, + Queue => 0, + IncludeContentForValue => '__CustomField__', +); + +my $data_uri = 'data:text/html;base64,PHNjcmlwdD5hbGVydChkb2N1bWVudC5jb29raWUpPC9zY3JpcHQ+'; +my $xss = q{')-eval(decodeURI('alert("xss")'))-('}; + +my $ticket = RT::Ticket->new(RT->SystemUser); +$ticket->Create( + Queue => 'General', + Subject => 'ticket A', + 'CustomField-'.$link->id => $data_uri, + 'CustomField-'.$include->id => $xss, +); +ok $ticket->Id, 'created ticket'; + +ok $m->login('root', 'password'), "logged in"; +$m->get_ok($base . "/Ticket/Display.html?id=" . $ticket->id); + +# look for lack of link to data:text/html;base64,... +ok !$m->find_link(text => $data_uri), "no data: link"; +ok !$m->find_link(url => $data_uri), "no data: link"; + +# look for unescaped JS +$m->content_lacks($xss, 'escaped js'); + +$m->warning_like(qr/Potentially dangerous URL type/, "found warning about dangerous link"); +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-2083-clickable-xss.t b/rt/t/security/CVE-2011-2083-clickable-xss.t new file mode 100644 index 000000000..008c80378 --- /dev/null +++ b/rt/t/security/CVE-2011-2083-clickable-xss.t @@ -0,0 +1,52 @@ +use strict; +use warnings; + +use RT::Test tests => undef; +use Test::Warn; + +my ($base, $m) = RT::Test->started_ok; + +my $ticket = RT::Test->create_ticket( + Queue => 'General', + Subject => 'test ticket A', +); +my $id = $ticket->id; +ok $id, "created ticket"; + +my @links = ( + 'javascript:alert("xss")', + 'data:text/html,<script>alert("xss")</script>', +); + +for my $link ( map { ($_, ucfirst $_) } @links ) { + my ($ok, $msg); + warnings_like { + ($ok, $msg) = $ticket->AddLink( + Type => 'RefersTo', + Target => $link, + ); + } [qr/Could not determine a URI scheme/, qr/Couldn't resolve/]; + ok !$ok, $msg; + + ok $m->login, "logged in"; + $m->get_ok($base); + $m->follow_link_ok({ text => 'test ticket A' }, 'ticket page'); + $m->follow_link_ok({ text => 'Links' }, 'links page'); + $m->submit_form_ok({ + with_fields => { + "$id-RefersTo" => $link, + }, + button => 'SubmitTicket', + }, 'submitted links page'); + $m->content_contains("Couldn't resolve "); + $m->next_warning_like(qr/Could not determine a URI scheme/, 'expected warning'); + $m->next_warning_like(qr/Couldn't resolve/, 'expected warning'); + + my $element = $m->find_link( url => $link ); + ok !$element, "no <a> link"; +} + +$m->no_leftover_warnings_ok; + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-2083-scrub.t b/rt/t/security/CVE-2011-2083-scrub.t new file mode 100644 index 000000000..f05378398 --- /dev/null +++ b/rt/t/security/CVE-2011-2083-scrub.t @@ -0,0 +1,18 @@ +use strict; +use warnings; + +use RT::Test nodb => 1, tests => undef; +use RT::Interface::Web; # This gets us HTML::Mason::Commands +use Test::LongString; + +{ + my $html = '<div id="metadata"><span class="actions"><a>OH HAI</a></span></div><p>Moose</p>'; + my $expected = '<div><span><a>OH HAI</a></span></div><p>Moose</p>'; + is_string(scrub_html($html), $expected, "class and id are stripped"); +} + +sub scrub_html { + return HTML::Mason::Commands::ScrubHTML(shift); +} + +done_testing; diff --git a/rt/t/security/CVE-2011-2084-attach-tickets.t b/rt/t/security/CVE-2011-2084-attach-tickets.t new file mode 100644 index 000000000..d7352cb85 --- /dev/null +++ b/rt/t/security/CVE-2011-2084-attach-tickets.t @@ -0,0 +1,64 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my $user = RT::Test->load_or_create_user( + Name => 'user', + EmailAddress => 'user@example.com', + Privileged => 1, + Password => 'password', +); + +ok( + RT::Test->set_rights( + { Principal => 'Everyone', Right => [qw/CreateTicket/] }, + { Principal => 'Requestor', Right => [qw/ShowTicket/] }, + ), + 'set rights' +); + +my $secret = "sekrit message"; + +RT::Test->create_tickets( + {}, + { + Subject => 'ticket A', + Requestor => $user->EmailAddress, + Content => "user's ticket", + }, + { + Subject => 'ticket B', + Requestor => 'root@localhost', + Content => $secret, + }, +); + +my $ticket_b = RT::Test->last_ticket; + +my ($baseurl, $m) = RT::Test->started_ok; +ok $m->login( 'user', 'password' ), 'logged in as user'; + +$m->get_ok("$baseurl/Ticket/Display.html?id=" . $ticket_b->id); +$m->content_contains('No permission'); +$m->warning_like(qr/no permission/i, 'no permission warning'); + +RT::Test->clean_caught_mails; + +# Ticket Create is just one example of where this is vulnerable +$m->get_ok('/Ticket/Create.html?Queue=1'); +$m->submit_form_ok({ + form_name => 'TicketCreate', + fields => { + Subject => 'ticket C', + AttachTickets => $ticket_b->id, + }, +}, 'create a ticket'); + +my @mail = RT::Test->fetch_caught_mails; +ok @mail, "got some outgoing emails"; +unlike $mail[0], qr/\Q$secret\E/, "doesn't contain ticket user can't see"; + +undef $m; +done_testing; + diff --git a/rt/t/security/CVE-2011-2084-cf-values.t b/rt/t/security/CVE-2011-2084-cf-values.t new file mode 100644 index 000000000..1178b15af --- /dev/null +++ b/rt/t/security/CVE-2011-2084-cf-values.t @@ -0,0 +1,132 @@ +use strict; +use warnings; + +use RT::Test tests => undef; +use JSON qw(decode_json); + +my ($base, $m) = RT::Test->started_ok; + +my $cf1 = RT::Test->load_or_create_custom_field( + Name => 'cf1', + Type => 'Select', + MaxValues => 1, + Queue => 0, +); +ok $cf1->id, "created cf1"; + +my $cf2 = RT::Test->load_or_create_custom_field( + Name => 'cf2', + Type => 'Select', + MaxValues => 1, + Queue => 0, +); +ok $cf2->id, "created cf2"; + +ok( $cf1->AddValue( Name => "cf1 value $_" ) ) for qw(a b c); +ok( $cf2->AddValue( Name => "cf2 value $_" ) ) for qw(x y z); + +sub ac { + my (%args) = ( + CF => $cf1->id, + Term => "%", + Context => undef, + ContextId => undef, + ContextType => undef, + @_ + ); + $args{term} = delete $args{Term}; + + if (my $obj = delete $args{Context}) { + $args{ContextId} = $obj->Id unless defined $args{ContextId}; + $args{ContextType} = ref($obj) unless defined $args{ContextType}; + } + + $args{"Object---CustomField-$args{CF}-Values"} = ""; + delete $args{CF}; + + delete $args{$_} for grep {not defined $args{$_}} keys %args; + + my $URI = URI->new("$base/Helpers/Autocomplete/CustomFieldValues"); + $URI->query_form( %args ); + $m->get_ok($URI, "GET to autocompleter"); + return decode_json($m->content); +} + +$m->login; +is_deeply ac(CF => 12345, ContextId => 1, ContextType => "RT::Queue"), + [], 'nothing for invalid CF'; + +is_deeply ac(), + [], "Nothing without a context id"; +is_deeply ac( ContextId => 12345, ContextType => "RT::Queue"), + [], "Nothing with invalid contextid id"; +is_deeply ac( ContextId => 12, ContextType => "RT::User"), + [], "Nothing with invalid contextid type"; + + + +my $user = RT::Test->load_or_create_user( + Name => 'user', + Password => 'password', + Privileged => 1, +); +my $queue = RT::Test->load_or_create_queue( Name => 'CF Test' ); +ok $queue->id, 'found or created queue'; +my $ticket = RT::Test->create_ticket( + Queue => $queue->id, + Subject => "CF application", +); +ok $queue->id, 'created ticket'; + +$m->logout; +$m->login('user','password'); + +is_deeply ac( Context => $queue ), [], 'queue context, no permissions, no result'; +is_deeply ac( Context => $ticket ), [], 'ticket context, no permissions, no result'; + +ok( RT::Test->set_rights( + { Principal => $user, Right => [qw(SeeCustomField)], Object => $queue }, +), 'add queue level CF viewing rights'); + +my $cfvalues = [ ( map { { value => "cf1 value $_" , label => "cf1 value $_" } } qw(a b c) ) ]; +is_deeply ac( Context => $queue ), $cfvalues, 'queue context, with permissions get result'; +is_deeply ac( Context => $ticket ), $cfvalues, 'ticket context, with permissions get result'; + +{ + diag "Switching to non-global CFs"; + my $globalq = RT::Queue->new( RT->SystemUser ); + my ($status, $msg) = $cf1->RemoveFromObject( $globalq ); + ok($status, "Removed CF1 globally: $msg"); + ($status, $msg) = $cf1->AddToObject( $queue ); + ok($status, "Added CF1 to queue @{[$queue->id]}: $msg"); + ($status, $msg) = $cf2->RemoveFromObject( $globalq ); + ok($status, "Removed CF2 globally: $msg"); +} + +is_deeply ac( CF => $cf2->id, Context => $queue ), [], 'queue context, but not applied, get no result'; +is_deeply ac( CF => $cf2->id, Context => $ticket ), [], 'ticket context, but not applied, get no result'; + +is_deeply ac( Context => $queue ), $cfvalues, 'queue context, applied correctly, get result'; +is_deeply ac( Context => $ticket ), $cfvalues, 'ticket context, applied correctly, get result'; + + + +diag "Ticket-level rights"; + +ok( RT::Test->set_rights( + { Principal => "Owner", Right => [qw(SeeCustomField)], Object => $queue }, + { Principal => $user, Right => [qw(OwnTicket SeeTicket)], Object => RT->System }, +), 'add owner level CF viewing rights'); + +is_deeply ac( Context => $queue ), [], 'queue context, but not owner'; +is_deeply ac( Context => $ticket ), [], 'ticket context, but not owner'; + +my ($status, $msg) = $ticket->SetOwner( $user->id ); +ok( $status, "Set owner to user: $msg" ); + +is_deeply ac( Context => $queue ), [], 'queue context is not enough'; +is_deeply ac( Context => $ticket ), $cfvalues, 'ticket context, get values'; + + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-2084-modifyscrips-templates.t b/rt/t/security/CVE-2011-2084-modifyscrips-templates.t new file mode 100644 index 000000000..f68706e52 --- /dev/null +++ b/rt/t/security/CVE-2011-2084-modifyscrips-templates.t @@ -0,0 +1,126 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +sub set_fails { + my $col = shift; + my $obj = shift; + my $to = ref $_[0] ? +shift->Id : shift; + my $from = $obj->$col; + my $meth = "Set$col"; + + my ($ok, $msg) = $obj->$meth($to); + ok !$ok, "$meth denied: $msg"; + is $obj->$col, $from, "$col left alone"; +} + +sub set_ok { + my $col = shift; + my $obj = shift; + my $to = ref $_[0] ? +shift->Id : shift; + my $from = $obj->$col; + my $meth = "Set$col"; + + my ($ok, $msg) = $obj->$meth($to); + ok $ok, "$meth allowed: $msg"; + is $obj->$col, $to, "$col updated"; +} + +my $qa = RT::Test->load_or_create_queue( Name => 'Queue A' ); +my $qb = RT::Test->load_or_create_queue( Name => 'Queue B' ); +ok $qa->id, "created Queue A"; +ok $qb->id, "created Queue B"; + +my $user = RT::Test->load_or_create_user( Name => 'testuser' ); +my $cu = RT::CurrentUser->new( $user ); +ok $user->id, "created testuser"; + +diag "ModifyScrips"; +{ + my $scrip = RT::Scrip->new( RT->SystemUser ); + my ($scrip_id, $msg) = $scrip->Create( + Description => 'Testing', + Queue => $qa->Id, + ScripCondition => 'User Defined', + ScripAction => 'User Defined', + Template => 'Blank', + CustomIsApplicableCode => 'if ($self->TicketObj->Subject =~ /fire/) { return (1);} else { return(0)}', + CustomPrepareCode => '1;', + CustomCommitCode => 'warn "scrip fired!";', + ); + ok $scrip_id, $msg; + + RT::Test->set_rights( + { Principal => $user, Right => 'ShowScrips' }, + { Principal => $user, Right => 'ModifyScrips', Object => $qa }, + ); + + $scrip = RT::Scrip->new( $cu ); + $scrip->Load( $scrip_id ); + ok $scrip->id, "loaded scrip as test user"; + is $scrip->Queue, $qa->Id, 'queue is A'; + + ok +($scrip->SetName('Testing ModifyScrips')); + + set_fails( Queue => $scrip => $qb ); + set_fails( Queue => $scrip => 0 ); + set_fails( Queue => $scrip => undef ); + set_fails( Queue => $scrip => '' ); + + RT::Test->add_rights( Principal => $user, Right => 'ModifyScrips', Object => $qb ); + + set_ok( Queue => $scrip => $qb ); + set_fails( Queue => $scrip => 0 ); + set_fails( Queue => $scrip => undef ); + set_fails( Queue => $scrip => '' ); + + RT::Test->add_rights( Principal => $user, Right => 'ModifyScrips' ); + + set_ok( Queue => $scrip => 0 ); + + set_fails( Template => $scrip => 2 ); + + RT::Test->add_rights( Principal => $user, Right => 'ShowTemplate' ); + + set_ok( Template => $scrip => 2 ); + is $scrip->TemplateObj->Name, 'Autoreply', 'template name is right'; +} + +diag "ModifyTemplate"; +{ + RT::Test->set_rights( + { Principal => $user, Right => 'ShowTemplate' }, + { Principal => $user, Right => 'ModifyTemplate', Object => $qa }, + ); + + my $template = RT::Template->new( RT->SystemUser ); + my ($id, $msg) = $template->Create( + Queue => $qa->Id, + Name => 'Testing', + Type => 'Perl', + Content => "\n\nThis is a test template.\n", + ); + ok $id, $msg; + + $template = RT::Template->new( $cu ); + $template->Load( $id ); + ok $template->id, "loaded template as test user"; + is $template->Queue, $qa->Id, 'queue is A'; + + ok +($template->SetName('Testing ModifyTemplate')); + + set_fails( Queue => $template => $qb ); + set_fails( Queue => $template => 0 ); + + RT::Test->add_rights( Principal => $user, Right => 'ModifyTemplate', Object => $qb ); + + set_ok( Queue => $template => $qb ); + set_fails( Queue => $template => 0 ); + + RT::Test->add_rights( Principal => $user, Right => 'ModifyTemplate' ); + + set_ok( Queue => $template => 0 ); +} + +done_testing; diff --git a/rt/t/security/CVE-2011-2084-transactions.t b/rt/t/security/CVE-2011-2084-transactions.t new file mode 100644 index 000000000..817288ded --- /dev/null +++ b/rt/t/security/CVE-2011-2084-transactions.t @@ -0,0 +1,59 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +# A privileged user, but with no privs +my $bad = RT::Test->load_or_create_user( + Name => 'testing', + EmailAddress => 'test@example.com', + Password => 'password', +); +ok( $bad, "Got a user object back" ); +ok( $bad->id, "Successfully created a user" ); + + +# A ticket CF +my $obj = RT::Test->load_or_create_custom_field( + Name => "Private CF", + Type => "Freeform", + Queue => 0, +); + +my ($t) = RT::Test->create_tickets( {}, + { Subject => 'Testing' } +); +ok($t->id, "Created a ticket"); + +# Add a txn on it +my ($cfid) = $t->AddCustomFieldValue( + Field => $obj->Id, + Value => "hidden-value" +); +ok($cfid, "Got CF id $cfid"); +my $update_id = $t->Transactions->Last->Id; + +# Somebody else shouldn't be able to see the old and new values +my ($base, $m) = RT::Test->started_ok; +$m->post_ok("$base/REST/1.0/transaction/$update_id", [ + user => 'testing', + pass => 'password', + format => 'l', +]); +$m->content_lacks("hidden-value"); + +# Make a transaction on a user +my $root = RT::Test->load_or_create_user( Name => "root" ); +$root->SetHomePhone("hidden-value"); +$update_id = $root->Transactions->Last->Id; + +# Which should also be hidden from random privileged users +$m->post_ok("$base/REST/1.0/transaction/$update_id", [ + user => 'testing', + pass => 'password', + format => 'l', +]); +$m->content_lacks("hidden-value"); + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-4458-verp.t b/rt/t/security/CVE-2011-4458-verp.t new file mode 100644 index 000000000..f84b79403 --- /dev/null +++ b/rt/t/security/CVE-2011-4458-verp.t @@ -0,0 +1,48 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +RT->Config->Set( MailCommand => 'sendmailpipe' ); +RT->Config->Set( VERPPrefix => "verp-" ); +RT->Config->Set( VERPDomain => "example.com" ); + +# Ensure that the fake sendmail knows where to write to +$ENV{RT_MAILLOGFILE} = RT::Test->temp_directory . "/sendmailpipe.log"; +my $fake = File::Spec->rel2abs( File::Spec->catfile( + 't', 'security', 'fake-sendmail' ) ); +RT->Config->Set( SendmailPath => $fake); + +ok( + RT::Test->set_rights( + { Principal => 'Everyone', Right => [qw/CreateTicket/] }, + ), + 'set rights' +); + +my $bad = RT::Test->load_or_create_user( + EmailAddress => 'danger-$USER@example.com', +); +ok( $bad, "Got a user object back" ); +ok( $bad->id, "Successfully created a user" ); + +my $current_user = RT::CurrentUser->new(RT->SystemUser); +my ($id, $msg) = $current_user->Load($bad->Id); +ok( $id, "Loaded the user successfully" ); + +my $ticket = RT::Ticket->new( $current_user ); +($id, $msg) = $ticket->Create( + Requestor => $bad->Id, + Subject => "Danger, Will Robinson!", + Queue => "General" +); +ok( $id, "Created a ticket: $msg" ); + +open(LOG, "<", $ENV{RT_MAILLOGFILE}) or die "Can't open log file: $!"; +while (my $line = <LOG>) { + next unless $line =~ /^-f/; + like($line, qr/\$USER/, "Contains uninterpolated \$USER"); +} +close(LOG); + +done_testing; diff --git a/rt/t/security/CVE-2011-4460-rows-per-page.t b/rt/t/security/CVE-2011-4460-rows-per-page.t new file mode 100644 index 000000000..92d6853e5 --- /dev/null +++ b/rt/t/security/CVE-2011-4460-rows-per-page.t @@ -0,0 +1,32 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +plan skip_all => 'valid SQL only on mysql' + unless RT->Config->Get('DatabaseType') eq 'mysql'; + +my ($base, $m) = RT::Test->started_ok; +ok $m->login, "logged in"; + +my $t = RT::Ticket->new( RT->SystemUser ); +$t->Create( + Queue => 1, + Subject => 'seed', +); +ok $t->id, 'created seed ticket'; + +my $root = RT::User->new( RT->SystemUser ); +$root->Load('root'); +my $password = $root->__Value('Password'); +ok $password, 'pulled hashed password from db'; + +my $sql = q[1 union select 1+id as id, 1+id as EffectiveId, 1 as Queue, 'ticket' as Type, 0 as IssueStatement, 0 as Resolution, 12 as Owner, Password as Subject, 0 as InitialPriority, 0 as FinalPriority, 0 as Priority, 0 as TimeEstimated, 0 as TimeWorked, Name as Status, 0 as TimeLeft, null as Told, null as Starts, null as Started, null as Due, null as Resolved, 0 as LastUpdatedBy, null as LastUpdated, 6 as Creator, null as Created, 0 as Disabled from Users]; +RT::Interface::Web::EscapeURI(\$sql); + +$m->get_ok("$base/Search/Results.html?Format=id,Subject,Status;Query=id%3E0;OrderBy=|;Rows=$sql"); +$m->content_lacks($password, "our password hash doesn't show up!"); +$m->warning_like(qr/isn't numeric/); + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-5092-datetimeformat.t b/rt/t/security/CVE-2011-5092-datetimeformat.t new file mode 100644 index 000000000..470f4f4f6 --- /dev/null +++ b/rt/t/security/CVE-2011-5092-datetimeformat.t @@ -0,0 +1,48 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my ($base, $m) = RT::Test->started_ok; + +my $user = RT::Test->load_or_create_user( + Name => 'user', + Password => 'password', + Privileged => 1, +); + +ok $user->id, 'created user'; + +ok( + RT::Test->set_rights( + { Principal => 'privileged', Right => [qw(ModifySelf ShowTicket)] }, + ), + "granted ModifySelf to privileged" +); + +my $ticket = RT::Test->create_ticket( + Queue => 'General', + Subject => 'testing', +); + +ok $ticket->id, 'created ticket'; + +$m->login('user'); +$m->get_ok("$base/Prefs/Other.html"); +my $format = 'Formatters'; +$m->submit_form_ok({ + form_name => 'ModifyPreferences', + fields => { + DateTimeFormat => $format, + }, + button => 'Update', +}, 'update prefs'); +is $user->Preferences(RT->System, {})->{DateTimeFormat}, $format, 'set preference'; + +$m->no_warnings_ok; +$m->get_ok("$base/Ticket/Display.html?id=" . $ticket->id); +$m->next_warning_like(qr/Invalid date formatter.+?\Q$format\E/, 'invalid formatter warning'); +$m->content_lacks($_, "lacks formatter in page") for @RT::Date::FORMATTERS; + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-5092-graph-links.t b/rt/t/security/CVE-2011-5092-graph-links.t new file mode 100644 index 000000000..5e98dd3b5 --- /dev/null +++ b/rt/t/security/CVE-2011-5092-graph-links.t @@ -0,0 +1,27 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my ($base, $m) = RT::Test->started_ok; +$m->login; + +for my $arg (qw(LeadingLink ShowLinks)) { + my $ticket = RT::Test->create_ticket( + Queue => 'General', + Subject => 'testing', + ); + ok $ticket->id, 'created ticket'; + + ok !$ticket->ToldObj->Unix, 'no Told'; + $m->get_ok("$base/Ticket/Graphs/index.html?$arg=SetTold;id=" . $ticket->id); + + $ticket->Load($ticket->id); # cache busting + + ok !$ticket->ToldObj->Unix, 'still no Told'; + $m->content_lacks('GotoFirstItem', 'no GotoFirstItem error'); + $m->content_like(qr|<img[^>]+?src=['"]/Ticket/Graphs/@{[$ticket->id]}|, 'found image element'); +} + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-5092-installmode.t b/rt/t/security/CVE-2011-5092-installmode.t new file mode 100644 index 000000000..ce88a4fec --- /dev/null +++ b/rt/t/security/CVE-2011-5092-installmode.t @@ -0,0 +1,24 @@ +use strict; +use warnings; + +BEGIN { + $ENV{RT_TEST_WEB_HANDLER} = 'inline'; +} + +use RT::Test tests => undef; +use Test::Warn; + +my ($base, $m) = RT::Test->started_ok; + +$m->login; +$m->content_like(qr/RT at a glance/i, 'homepage'); + +warning_like { + ok !RT->InstallMode(1), 'install mode failed to turn on'; +} qr/tried to turn on InstallMode/; + +$m->reload; +$m->content_like(qr/RT at a glance/i, 'still homepage'); + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-5092-localizeddatetime.t b/rt/t/security/CVE-2011-5092-localizeddatetime.t new file mode 100644 index 000000000..733afc08a --- /dev/null +++ b/rt/t/security/CVE-2011-5092-localizeddatetime.t @@ -0,0 +1,30 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my $root = RT::CurrentUser->new('root'); +my ($ok, $msg) = $root->UserObj->SetLang('en-us'); +ok $ok, $msg; + +my $year = (localtime time)[5] + 1900; +my $date = RT::Date->new( $root ); +$date->SetToNow; + +like $date->AsString( Format => 'LocalizedDateTime' ), + qr/\Q$year\E/, 'contains full year'; + +unlike $date->AsString( Format => 'LocalizedDateTime', DateFormat => 'date_format_short' ), + qr/\Q$year\E/, 'lacks full year'; + +eval { + $date->AsString( Format => 'LocalizedDateTime', DateFormat => 'bogus::format' ); +}; +ok !$@, "didn't die with bogus DateFormat"; + +eval { + $date->AsString( Format => 'LocalizedDateTime', TimeFormat => 'bogus::format' ); +}; +ok !$@, "didn't die with bogus TimeFormat"; + +done_testing; diff --git a/rt/t/security/CVE-2011-5092-prefs.t b/rt/t/security/CVE-2011-5092-prefs.t new file mode 100644 index 000000000..b8e15aae0 --- /dev/null +++ b/rt/t/security/CVE-2011-5092-prefs.t @@ -0,0 +1,77 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my ($base, $m) = RT::Test->started_ok; + +my $user = RT::Test->load_or_create_user( + Name => 'ausername', + EmailAddress => 'user@example.com', + Password => 'password', + Privileged => 1, +); + +ok $user->id, 'created user'; + +ok( + RT::Test->set_rights( + { Principal => 'privileged', Right => [qw(ModifySelf ShowTicket)] }, + ), + "granted ModifySelf to privileged" +); + +$m->login('ausername'); + +{ + $m->get_ok("$base/Prefs/Other.html"); + my $style = '../css/base'; + $m->submit_form_ok({ + with_fields => { + WebDefaultStylesheet => $style, + }, + button => 'Update', + }, 'update prefs'); + is(RT->Config->Get('WebDefaultStylesheet', $user), $style, 'set preference'); + + SKIP: { + skip "RT::User->Stylesheet wasn't backported", 1 unless $user->can("Stylesheet"); + is $user->Stylesheet, RT->Config->Get('WebDefaultStylesheet'), '$user->Stylesheet is the default'; + } + + $m->get_ok($base); + $m->content_unlike(qr/<link.+?\Q$style\E/, "lack .. path in page <link>"); + $m->content_contains( RT->Config->Get('WebDefaultStylesheet') ); +} + +{ + $m->get_ok("$base/Prefs/Other.html"); + my $format = '/../../m/_elements/full_site_link'; + $m->submit_form_ok({ + form_name => 'ModifyPreferences', + fields => { + UsernameFormat => $format, + }, + button => 'Update', + }, 'update prefs'); + $m->content_contains('saved'); + + my $ticket = RT::Test->create_ticket( + Queue => 'General', + Subject => 'test ticket', + Requestor => 'user@example.com', + ); + ok $ticket->id, 'created ticket'; + $m->get_ok($base . "/Ticket/Display.html?id=" . $ticket->id); + $m->content_lacks('NotMobile', "lacks NotMobile"); + $m->next_warning_like(qr/UsernameFormat/, 'caught UsernameFormat warning'); +} + +{ + $m->get_ok("$base/Helpers/Toggle/ShowRequestor?Status=/../../../Elements/Logo;Requestor=root"); + $m->content_lacks('logo', "didn't display /Elements/Logo"); + $m->content_contains('Results.html', "found link to search results"); +} + +undef $m; +done_testing; diff --git a/rt/t/security/CVE-2011-5093-execute-code.t b/rt/t/security/CVE-2011-5093-execute-code.t new file mode 100644 index 000000000..5124ab88b --- /dev/null +++ b/rt/t/security/CVE-2011-5093-execute-code.t @@ -0,0 +1,53 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my $template = RT::Template->new( RT->SystemUser ); +my ($ok, $msg) = $template->Create( + Queue => 0, + Name => 'test', + Type => 'Simple', + Content => <<'.', +===Create-Ticket: testing +Queue: General +Subject: duplicate: { $Tickets{TOP}->Subject } +. +); +ok $ok, $msg; + +my $ticket = RT::Test->create_ticket( + Queue => 'General', + Subject => 'a ticket', +); +ok $ticket->id, "created ticket"; + +for my $type (qw(Simple Perl)) { + if ($template->Type ne $type) { + my ($ok, $msg) = $template->SetType($type); + ok $ok, $msg; + } + + require RT::Action::CreateTickets; + my $action = RT::Action::CreateTickets->new( + CurrentUser => RT->SystemUser, + TemplateObj => $template, + TicketObj => $ticket, + ); + $action->{TransactionObj} = $ticket->Transactions->First; + ok $action->Prepare, 'prepares'; + ok $action->Commit, 'commits'; + + my $new_ticket = RT::Test->last_ticket; + ok $new_ticket->id > $ticket->id, 'new ticket'; + + if ($type eq 'Perl') { + is $new_ticket->Subject, 'duplicate: a ticket', 'interpolated'; + isnt $new_ticket->Subject, 'duplicate: { $Tickets{TOP}->Subject }', 'interpolated'; + } else { + isnt $new_ticket->Subject, 'duplicate: a ticket', 'not interpolated'; + is $new_ticket->Subject, 'duplicate: { $Tickets{TOP}->Subject }', 'not interpolated'; + } +} + +done_testing; diff --git a/rt/t/security/fake-sendmail b/rt/t/security/fake-sendmail new file mode 100644 index 000000000..43259b603 --- /dev/null +++ b/rt/t/security/fake-sendmail @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +die "No \$RT_MAILLOGFILE set in environment" + unless $ENV{RT_MAILLOGFILE}; +open LOG, ">", $ENV{RT_MAILLOGFILE} + or die "Can't write to $ENV{RT_MAILLOGFILE}: $!"; + +my $needs_newline; +for (@ARGV) { + if (/^-/) { + print LOG "\n" if $needs_newline++; + print LOG $_; + } else { + print LOG " $_"; + } +} +print LOG "\n"; + +1 while $_ = <STDIN>; + +exit 0; diff --git a/rt/t/ticket/race.t b/rt/t/ticket/race.t new file mode 100644 index 000000000..aa1150ecb --- /dev/null +++ b/rt/t/ticket/race.t @@ -0,0 +1,51 @@ +use strict; +use warnings; + +use RT::Test tests => 2; + +use constant KIDS => 50; + +my $id; + +{ + my $t = RT::Ticket->new( RT->SystemUser ); + ($id) = $t->Create( + Queue => "General", + Subject => "Race $$", + ); +} + +diag "Created ticket $id"; +RT->DatabaseHandle->Disconnect; + +my @kids; +for (1..KIDS) { + if (my $pid = fork()) { + push @kids, $pid; + next; + } + + # In the kid, load up the ticket and correspond + RT->ConnectToDatabase; + my $t = RT::Ticket->new( RT->SystemUser ); + $t->Load( $id ); + $t->Correspond( Content => "Correspondence from PID $$" ); + undef $t; + exit 0; +} + + +diag "Forked @kids"; +waitpid $_, 0 for @kids; +diag "All kids finished corresponding"; + +RT->ConnectToDatabase; +my $t = RT::Ticket->new( RT->SystemUser ); +$t->Load($id); +my $txns = $t->Transactions; +$txns->Limit( FIELD => 'Type', VALUE => 'Status' ); +is($txns->Count, 1, "Only one transaction change recorded" ); + +$txns = $t->Transactions; +$txns->Limit( FIELD => 'Type', VALUE => 'Correspond' ); +is($txns->Count, KIDS, "But all correspondences were recorded" ); diff --git a/rt/t/ticket/search_by_queue.t b/rt/t/ticket/search_by_queue.t new file mode 100644 index 000000000..0327152d5 --- /dev/null +++ b/rt/t/ticket/search_by_queue.t @@ -0,0 +1,60 @@ +use strict; +use warnings; + +use RT::Test nodata => 1, tests => 34; +use RT::Ticket; + +my $qa = RT::Test->load_or_create_queue( Name => 'Queue A' ); +ok $qa && $qa->id, 'loaded or created queue'; + +my $qb = RT::Test->load_or_create_queue( Name => 'Queue B' ); +ok $qb && $qb->id, 'loaded or created queue'; + +my @tickets = RT::Test->create_tickets( + {}, + { Queue => $qa->id, Subject => 'a1', }, + { Queue => $qa->id, Subject => 'a2', }, + { Queue => $qb->id, Subject => 'b1', }, + { Queue => $qb->id, Subject => 'b2', }, +); + +run_tests( \@tickets, + 'Queue = "Queue A"' => { a1 => 1, a2 => 1, b1 => 0, b2 => 0 }, + 'Queue = '. $qa->id => { a1 => 1, a2 => 1, b1 => 0, b2 => 0 }, + 'Queue != "Queue A"' => { a1 => 0, a2 => 0, b1 => 1, b2 => 1 }, + 'Queue != '. $qa->id => { a1 => 0, a2 => 0, b1 => 1, b2 => 1 }, + + 'Queue = "Queue B"' => { a1 => 0, a2 => 0, b1 => 1, b2 => 1 }, + 'Queue = '. $qb->id => { a1 => 0, a2 => 0, b1 => 1, b2 => 1 }, + 'Queue != "Queue B"' => { a1 => 1, a2 => 1, b1 => 0, b2 => 0 }, + 'Queue != '. $qb->id => { a1 => 1, a2 => 1, b1 => 0, b2 => 0 }, + + 'Queue = "Bad Queue"' => { a1 => 0, a2 => 0, b1 => 0, b2 => 0 }, + 'Queue != "Bad Queue"' => { a1 => 1, a2 => 1, b1 => 1, b2 => 1 }, +); + +sub run_tests { + my @tickets = @{ shift() }; + my %test = @_; + my $query_prefix = join ' OR ', map 'id = '. $_->id, @tickets; + foreach my $key ( sort keys %test ) { + my $tix = RT::Tickets->new(RT->SystemUser); + $tix->FromSQL( "( $query_prefix ) AND ( $key )" ); + + my $error = 0; + + my $count = 0; + $count++ foreach grep $_, values %{ $test{$key} }; + is($tix->Count, $count, "found correct number of ticket(s) by '$key'") or $error = 1; + + my $good_tickets = 1; + while ( my $ticket = $tix->Next ) { + next if $test{$key}->{ $ticket->Subject }; + diag $ticket->Subject ." ticket has been found when it's not expected"; + $good_tickets = 0; + } + ok( $good_tickets, "all tickets are good with '$key'" ) or $error = 1; + + diag "Wrong SQL query for '$key':". $tix->BuildSelectQuery if $error; + } +} diff --git a/rt/t/web/action-results.t b/rt/t/web/action-results.t new file mode 100644 index 000000000..db8c26bb8 --- /dev/null +++ b/rt/t/web/action-results.t @@ -0,0 +1,48 @@ +use strict; +use warnings; +use RT::Test tests => 'no_declare'; + +my ($url, $m) = RT::Test->started_ok; + +ok $m->login, "Logged in"; + +# We test two ticket creation paths since one historically doesn't update the +# session (quick create) and the other does. +for my $quick (1, 0) { + diag $quick ? "Quick ticket creation" : "Normal ticket creation"; + + $m->get_ok("/"); + $m->submit_form_ok({ form_name => 'CreateTicketInQueue' }, "Create new ticket form") + unless $quick; + $m->submit_form_ok({ + with_fields => { + Subject => "The Plants", + Content => "Please water them.", + }, + }, "Submitted new ticket"); + + my $id = RT::Test->last_ticket->id; + + like $m->uri, qr/results=[A-Za-z0-9]{32}/, "URI contains results hash"; + $m->content_contains("Ticket $id created", "Page contains results message"); + $m->content_contains("#$id: The Plants") unless $quick; + + diag "Reloading without a referer but with a results hash doesn't trigger the CSRF"; { + # Mech's API here sucks. To drop the Referer and simulate a real browser + # reload, we need to make a new request which explicitly adds an empty Referer + # header (causing it to never be sent) and then deletes the empty Referer + # header to let it be automatically managed again. + $m->add_header("Referer" => undef); + $m->get_ok( $m->uri, "Reloading the results page without a Referer" ); + $m->delete_header("Referer"); + + like $m->uri, qr/results=[A-Za-z0-9]{32}/, "URI contains results hash"; + $m->content_lacks("cross-site request forgery", "Skipped the CSRF interstitial") + or $m->follow_link_ok({ text => "click here to resume your request" }, "Ignoring CSRF warning"); + $m->content_lacks("Ticket $id created", "Page lacks results message"); + $m->content_contains("#$id: The Plants") unless $quick; + } +} + +undef $m; +done_testing; diff --git a/rt/t/web/admin_queue_lifecycle.t b/rt/t/web/admin_queue_lifecycle.t new file mode 100644 index 000000000..295e9ea57 --- /dev/null +++ b/rt/t/web/admin_queue_lifecycle.t @@ -0,0 +1,49 @@ +use strict; +use warnings; + +use RT::Test tests => 13; + +my $lifecycles = RT->Config->Get('Lifecycles'); +RT->Config->Set( Lifecycles => %{$lifecycles}, + foo => { + initial => ['initial'], + active => ['open'], + inactive => ['resolved'], + } +); + +RT::Lifecycle->FillCache(); + +my ( $url, $m ) = RT::Test->started_ok; +ok( $m->login(), 'logged in' ); + +$m->get_ok( $url . '/Admin/Queues/Modify.html?id=1' ); + +my $form = $m->form_name('ModifyQueue'); +my $lifecycle_input = $form->find_input('Lifecycle'); +is( $lifecycle_input->value, 'default', 'default lifecycle' ); + +my @lifecycles = sort $lifecycle_input->possible_values; +is_deeply( \@lifecycles, [qw/approvals default foo/], 'found all lifecycles' ); + +$m->submit_form(); +$m->content_lacks( 'Lifecycle changed from', + 'no message of "Lifecycle changed from"' ); +$m->content_lacks( 'That is already the current value', + 'no message of "That is already the current value"' ); + +$form = $m->form_name('ModifyQueue'); +$m->submit_form( fields => { Lifecycle => 'foo' }, ); +$m->content_contains( + 'Lifecycle changed from "default" to "foo"'); +$lifecycle_input = $form->find_input('Lifecycle'); +is( $lifecycle_input->value, 'foo', 'lifecycle is changed to foo' ); + +$form = $m->form_name('ModifyQueue'); +$m->submit_form( fields => { Lifecycle => 'default' }, ); +$m->content_contains( + 'Lifecycle changed from "foo" to "default"'); +$lifecycle_input = $form->find_input('Lifecycle'); +is( $lifecycle_input->value, 'default', + 'lifecycle is changed back to default' ); + diff --git a/rt/t/web/attachment_encoding.t b/rt/t/web/attachment_encoding.t index 5af7fda20..f49720e0f 100644 --- a/rt/t/web/attachment_encoding.t +++ b/rt/t/web/attachment_encoding.t @@ -3,14 +3,15 @@ use strict; use warnings; use RT::Test tests => 32; -use Encode; my ( $baseurl, $m ) = RT::Test->started_ok; ok $m->login, 'logged in as root'; -use utf8; - use File::Spec; +my $subject = Encode::decode("UTF-8",'标题'); +my $content = Encode::decode("UTF-8",'测试'); +my $filename = Encode::decode("UTF-8",'附件.txt'); + diag 'test without attachments' if $ENV{TEST_VERBOSE}; { @@ -19,13 +20,13 @@ diag 'test without attachments' if $ENV{TEST_VERBOSE}; $m->form_name('TicketModify'); $m->submit_form( form_number => 3, - fields => { Subject => '标题', Content => '测试' }, + fields => { Subject => $subject, Content => $content }, ); $m->content_like( qr/Ticket \d+ created/i, 'created the ticket' ); $m->follow_link_ok( { text => 'with headers' }, '-> /Ticket/Attachment/WithHeaders/...' ); - $m->content_contains( '标题', 'has subject 标题' ); - $m->content_contains( '测试', 'has content 测试' ); + $m->content_contains( $subject, "has subject $subject" ); + $m->content_contains( $content, "has content $content" ); my ( $id ) = $m->uri =~ /(\d+)$/; ok( $id, 'found attachment id' ); @@ -35,8 +36,8 @@ diag 'test without attachments' if $ENV{TEST_VERBOSE}; ok( $attachment->SetHeader( 'X-RT-Original-Encoding' => 'gbk' ), 'set original encoding to gbk' ); $m->get( $m->uri ); - $m->content_contains( '标题', 'has subject 标题' ); - $m->content_contains( '测试', 'has content 测试' ); + $m->content_contains( $subject, "has subject $subject" ); + $m->content_contains( $content, "has content $content" ); } diag 'test with attachemnts' if $ENV{TEST_VERBOSE}; @@ -44,10 +45,10 @@ diag 'test with attachemnts' if $ENV{TEST_VERBOSE}; { my $file = - File::Spec->catfile( RT::Test->temp_directory, encode_utf8 '附件.txt' ); + File::Spec->catfile( RT::Test->temp_directory, Encode::encode("UTF-8",$filename) ); open( my $fh, '>', $file ) or die $!; binmode $fh, ':utf8'; - print $fh '附件'; + print $fh $filename; close $fh; $m->get_ok( $baseurl . '/Ticket/Create.html?Queue=1' ); @@ -55,17 +56,17 @@ diag 'test with attachemnts' if $ENV{TEST_VERBOSE}; $m->form_name('TicketModify'); $m->submit_form( form_number => 3, - fields => { Subject => '标题', Content => '测试', Attach => $file }, + fields => { Subject => $subject, Content => $content, Attach => $file }, ); $m->content_like( qr/Ticket \d+ created/i, 'created the ticket' ); - $m->content_contains( '附件.txt', 'attached filename' ); - $m->content_lacks( encode_utf8 '附件.txt', 'no double encoded attached filename' ); + $m->content_contains( $filename, 'attached filename' ); + $m->content_lacks( Encode::encode("UTF-8",$filename), 'no double encoded attached filename' ); $m->follow_link_ok( { text => 'with headers' }, '-> /Ticket/Attachment/WithHeaders/...' ); # subject is in the parent attachment, so there is no 标题 - $m->content_lacks( '标题', 'does not have content 标题' ); - $m->content_contains( '测试', 'has content 测试' ); + $m->content_lacks( $subject, "does not have content $subject" ); + $m->content_contains( $content, "has content $content" ); my ( $id ) = $m->uri =~ /(\d+)$/; ok( $id, 'found attachment id' ); @@ -75,15 +76,15 @@ diag 'test with attachemnts' if $ENV{TEST_VERBOSE}; ok( $attachment->SetHeader( 'X-RT-Original-Encoding' => 'gbk' ), 'set original encoding to gbk' ); $m->get( $m->uri ); - $m->content_lacks( '标题', 'does not have content 标题' ); - $m->content_contains( '测试', 'has content 测试' ); + $m->content_lacks( $subject, "does not have content $subject" ); + $m->content_contains( $content, "has content $content" ); $m->back; $m->back; - $m->follow_link_ok( { text => 'Download 附件.txt' }, + $m->follow_link_ok( { text => "Download $filename" }, '-> /Ticket/Attachment/...' ); - $m->content_contains( '附件', 'has content 附件' ); + $m->content_contains( $filename, "has file content $filename" ); ( $id ) = $m->uri =~ /(\d+)\D+$/; ok( $id, 'found attachment id' ); @@ -94,7 +95,7 @@ diag 'test with attachemnts' if $ENV{TEST_VERBOSE}; ok( $attachment->SetHeader( 'X-RT-Original-Encoding' => 'gbk' ), 'set original encoding to gbk' ); $m->get( $m->uri ); - $m->content_contains( '附件', 'has content 附件' ); + $m->content_contains( $filename, "has content $filename" ); unlink $file; } diff --git a/rt/t/web/basic.t b/rt/t/web/basic.t index e61e80e9c..02483b208 100644 --- a/rt/t/web/basic.t +++ b/rt/t/web/basic.t @@ -1,7 +1,6 @@ use strict; use warnings; -use Encode; use RT::Test tests => 23; @@ -27,7 +26,7 @@ my $url = $agent->rt_base_url; $agent->goto_create_ticket(1); is ($agent->status, 200, "Loaded Create.html"); $agent->form_name('TicketCreate'); - my $string = Encode::decode_utf8("I18N Web Testing æøå"); + my $string = Encode::decode("UTF-8","I18N Web Testing æøå"); $agent->field('Subject' => "Ticket with utf8 body"); $agent->field('Content' => $string); ok($agent->submit, "Created new ticket with $string as Content"); @@ -49,7 +48,7 @@ my $url = $agent->rt_base_url; is ($agent->status, 200, "Loaded Create.html"); $agent->form_name('TicketCreate'); - my $string = Encode::decode_utf8("I18N Web Testing æøå"); + my $string = Encode::decode( "UTF-8","I18N Web Testing æøå"); $agent->field('Subject' => $string); $agent->field('Content' => "Ticket with utf8 subject"); ok($agent->submit, "Created new ticket with $string as Content"); diff --git a/rt/t/web/cf_date.t b/rt/t/web/cf_date.t index e69833c13..2180e140f 100644 --- a/rt/t/web/cf_date.t +++ b/rt/t/web/cf_date.t @@ -189,4 +189,85 @@ diag 'check invalid inputs'; is_deeply( @warnings, q{Couldn't parse date 'foodate' by Time::ParseDate} ); } +diag 'retain values when adding attachments'; +{ + my ( $ticket, $id ); + + my $txn_cf = RT::CustomField->new( RT->SystemUser ); + my ( $ret, $msg ) = $txn_cf->Create( + Name => 'test txn cf date', + TypeComposite => 'Date-1', + LookupType => 'RT::Queue-RT::Ticket-RT::Transaction', + ); + ok( $ret, "created 'txn datetime': $msg" ); + $txn_cf->AddToObject(RT::Queue->new(RT->SystemUser)); + my $txn_cfid = $txn_cf->id; + + $m->submit_form( + form_name => "CreateTicketInQueue", + fields => { Queue => 'General' }, + ); + $m->content_contains('test cf date', 'has cf' ); + $m->content_contains('test txn cf date', 'has txn cf' ); + + $m->submit_form_ok( + { + form_name => "TicketCreate", + fields => { + Subject => 'test 2015-06-04', + Content => 'test', + "Object-RT::Ticket--CustomField-$cfid-Values" => '2015-06-04', + "Object-RT::Transaction--CustomField-$txn_cfid-Values" => '2015-08-15', + }, + button => 'AddMoreAttach', + }, + 'create test ticket' + ); + $m->form_name("TicketCreate"); + is( $m->value( "Object-RT::Ticket--CustomField-$cfid-Values" ), + "2015-06-04", "ticket cf date value still on form" ); + is( $m->value( "Object-RT::Transaction--CustomField-$txn_cfid-Values" ), + "2015-08-15", "txn cf date date value still on form" ); + + $m->submit_form(); + ok( ($id) = $m->content =~ /Ticket (\d+) created/, "created ticket $id" ); + + $m->follow_link_ok( {text => 'Reply'} ); + $m->title_like( qr/Update/ ); + $m->content_contains('test txn cf date', 'has txn cf'); + $m->submit_form_ok( + { + form_name => "TicketUpdate", + fields => { + Content => 'test', + "Object-RT::Transaction--CustomField-$txn_cfid-Values" => '2015-09-16', + }, + button => 'AddMoreAttach', + }, + 'Update test ticket' + ); + $m->form_name("TicketUpdate"); + is( $m->value( "Object-RT::Transaction--CustomField-$txn_cfid-Values" ), + "2015-09-16", "txn date value still on form" ); + + $m->follow_link_ok( {text => 'Jumbo'} ); + $m->title_like( qr/Jumbo/ ); + + $m->submit_form_ok( + { + form_name => "TicketModifyAll", + fields => { + "Object-RT::Transaction--CustomField-$txn_cfid-Values" => + '2015-12-16', + }, + button => 'AddMoreAttach', + }, + 'jumbo form' + ); + + $m->form_name("TicketModifyAll"); + is( $m->value( "Object-RT::Transaction--CustomField-$txn_cfid-Values" ), + "2015-12-16", "txn date value still on form" ); +} + done_testing; diff --git a/rt/t/web/cf_datetime.t b/rt/t/web/cf_datetime.t index 4580c4a4f..72a8b3f7e 100644 --- a/rt/t/web/cf_datetime.t +++ b/rt/t/web/cf_datetime.t @@ -215,6 +215,92 @@ diag 'check invalid inputs'; is_deeply( @warnings, q{Couldn't parse date 'foodate' by Time::ParseDate} ); } +diag 'retain values when adding attachments'; +{ + my ( $ticket, $id ); + + my $txn_cf = RT::CustomField->new( RT->SystemUser ); + my ( $ret, $msg ) = $txn_cf->Create( + Name => 'test txn cf datetime', + TypeComposite => 'DateTime-1', + LookupType => 'RT::Queue-RT::Ticket-RT::Transaction', + ); + ok( $ret, "created 'txn datetime': $msg" ); + $txn_cf->AddToObject(RT::Queue->new(RT->SystemUser)); + my $txn_cfid = $txn_cf->id; + + $m->submit_form( + form_name => "CreateTicketInQueue", + fields => { Queue => 'General' }, + ); + $m->content_contains('test cf datetime', 'has cf' ); + $m->content_contains('test txn cf datetime', 'has txn cf' ); + + $m->submit_form_ok( + { + form_name => "TicketCreate", + fields => { + Subject => 'test 2015-06-04', + Content => 'test', + "Object-RT::Ticket--CustomField-$cfid-Values" => '2015-06-04 08:30:00', + "Object-RT::Transaction--CustomField-$txn_cfid-Values" => '2015-08-15 12:30:30', + }, + button => 'AddMoreAttach', + }, + 'Create test ticket' + ); + $m->form_name("TicketCreate"); + is( $m->value( "Object-RT::Ticket--CustomField-$cfid-Values" ), + "2015-06-04 08:30:00", "ticket cf date value still on form" ); + $m->content_contains( "Jun 04 08:30:00 2015", 'date in parens' ); + is( $m->value( "Object-RT::Transaction--CustomField-$txn_cfid-Values" ), + "2015-08-15 12:30:30", "txn cf date date value still on form" ); + $m->content_contains( "Aug 15 12:30:30 2015", 'date in parens' ); + + $m->submit_form(); + ok( ($id) = $m->content =~ /Ticket (\d+) created/, "Created ticket $id" ); + + $m->follow_link_ok( {text => 'Reply'} ); + $m->title_like( qr/Update/ ); + $m->content_contains('test txn cf date', 'has txn cf'); + $m->submit_form_ok( + { + form_name => "TicketUpdate", + fields => { + Content => 'test', + "Object-RT::Transaction--CustomField-$txn_cfid-Values" => '2015-09-16 09:30:40', + }, + button => 'AddMoreAttach', + }, + 'Update test ticket' + ); + $m->form_name("TicketUpdate"); + is( $m->value( "Object-RT::Transaction--CustomField-$txn_cfid-Values" ), + "2015-09-16 09:30:40", "Date value still on form" ); + $m->content_contains( "Sep 16 09:30:40 2015", 'date in parens' ); + + $m->follow_link_ok( {text => 'Jumbo'} ); + $m->title_like( qr/Jumbo/ ); + + $m->submit_form_ok( + { + form_name => "TicketModifyAll", + fields => { + "Object-RT::Transaction--CustomField-$txn_cfid-Values" => + '2015-12-16 03:00:00', + }, + button => 'AddMoreAttach', + }, + 'jumbo form' + ); + $m->save_content('/tmp/x.html'); + + $m->form_name("TicketModifyAll"); + is( $m->value( "Object-RT::Transaction--CustomField-$txn_cfid-Values" ), + "2015-12-16 03:00:00", "txn date value still on form" ); + $m->content_contains( "Dec 16 03:00:00 2015", 'date in parens' ); +} + sub is_results_number { local $Test::Builder::Level = $Test::Builder::Level + 1; my $fields = shift; diff --git a/rt/t/web/cf_values_class.t b/rt/t/web/cf_values_class.t new file mode 100644 index 000000000..646642781 --- /dev/null +++ b/rt/t/web/cf_values_class.t @@ -0,0 +1,54 @@ +use strict; +use warnings; + +use RT::Test tests => 8; + +use constant VALUES_CLASS => 'RT::CustomFieldValues::Groups'; +RT->Config->Set(CustomFieldValuesSources => VALUES_CLASS); + +my ($baseurl, $m) = RT::Test->started_ok; +ok $m->login, 'logged in as root'; + +my $cf_name = 'test values class'; + +my $cfid; +diag "Create a CF"; +{ + $m->follow_link( id => 'tools-config-custom-fields-create'); + $m->submit_form( + form_name => "ModifyCustomField", + fields => { + Name => $cf_name, + TypeComposite => 'Select-1', + LookupType => 'RT::Queue-RT::Ticket', + }, + ); + $m->content_contains('Object created', 'created Select-1' ); + $cfid = $m->form_name('ModifyCustomField')->value('id'); + ok $cfid, "found id of the CF in the form, it's #$cfid"; +} + +diag "change to external values class"; +{ + $m->submit_form( + form_name => "ModifyCustomField", + fields => { ValuesClass => 'RT::CustomFieldValues::Groups', }, + button => 'Update', + ); + $m->content_contains( + "Field values source changed from 'RT::CustomFieldValues' to 'RT::CustomFieldValues::Groups'", + 'changed to external values class' ); +} + +diag "change to internal values class"; +{ + $m->submit_form( + form_name => "ModifyCustomField", + fields => { ValuesClass => 'RT::CustomFieldValues', }, + button => 'Update', + ); + $m->content_contains( + "Field values source changed from 'RT::CustomFieldValues::Groups' to 'RT::CustomFieldValues'", + 'changed to internal values class' ); +} + diff --git a/rt/t/web/command_line_cf_edge_cases.t b/rt/t/web/command_line_cf_edge_cases.t new file mode 100644 index 000000000..d7c777768 --- /dev/null +++ b/rt/t/web/command_line_cf_edge_cases.t @@ -0,0 +1,87 @@ +use strict; +use warnings; +use Test::Expect; +use RT::Test tests => 100, actual_server => 1; +my ( $baseurl, $m ) = RT::Test->started_ok; + +my $rt_tool_path = "$RT::BinPath/rt"; + +$ENV{'RTUSER'} = 'root'; +$ENV{'RTPASSWD'} = 'password'; +$ENV{'RTSERVER'} = RT->Config->Get('WebBaseURL'); +$ENV{'RTDEBUG'} = '1'; +$ENV{'RTCONFIG'} = '/dev/null'; + +my @cfs = ( + 'foo=bar', 'foo.bar', 'foo:bar', 'foo bar', + 'foo{bar}', 'foo-bar', 'foo()bar', +); +for my $name (@cfs) { + RT::Test->load_or_create_custom_field( + Name => $name, + Type => 'Freeform', + MaxValues => 1, + Queue => 0, + ); +} + +expect_run( + command => "$rt_tool_path shell", + prompt => 'rt> ', + quit => 'quit', +); + +# create a ticket +for my $name (@cfs) { + expect_send( +qq{create -t ticket set subject='test cf $name' 'CF.{$name}=foo:b a.r=baz'}, + "creating a ticket for cf $name" + ); + + expect_handle->before() =~ /Ticket (\d+) created/; + my $ticket_id = $1; + + expect_send( "show ticket/$ticket_id -f 'CF.{$name}'", + 'checking new value' ); + expect_like( qr/CF\.{\Q$name\E}: foo:b a\.r=baz/i, 'verified change' ); + + expect_send( "edit ticket/$ticket_id set 'CF.{$name}=bar'", + "changing cf $name to bar" ); + expect_like( qr/Ticket $ticket_id updated/, 'changed cf' ); + expect_send( "show ticket/$ticket_id -f 'CF.{$name}'", + 'checking new value' ); + expect_like( qr/CF\.{\Q$name\E}: bar/i, 'verified change' ); + + expect_send( +qq{create -t ticket set subject='test cf $name' 'CF-$name=foo:b a.r=baz'}, + "creating a ticket for cf $name" + ); + expect_handle->before() =~ /Ticket (\d+) created/; + $ticket_id = $1; + + expect_send( "show ticket/$ticket_id -f 'CF-$name'", 'checking new value' ); + if ( $name eq 'foo=bar' ) { + expect_like( qr/CF\.{\Q$name\E}: $/mi, + "can't use = in cf name with old style" ); + } + else { + expect_like( qr/CF\.{\Q$name\E}: foo:b a\.r=baz/i, 'verified change' ); + expect_send( "edit ticket/$ticket_id set 'CF-$name=bar'", + "changing cf $name to bar" ); + expect_like( qr/Ticket $ticket_id updated/, 'changed cf' ); + expect_send( "show ticket/$ticket_id -f 'CF-$name'", + 'checking new value' ); + expect_like( qr/CF\.{\Q$name\E}: bar/i, 'verified change' ); + } +} + +my @invalid = ('foo,bar'); +for my $name (@invalid) { + expect_send( + qq{create -t ticket set subject='test cf $name' 'CF.{$name}=foo'}, + "creating a ticket for cf $name" ); + expect_like( qr/You shouldn't specify objects as arguments to create/i, + '$name is not a valid cf name' ); +} + +expect_quit(); diff --git a/rt/t/web/compilation_errors.t b/rt/t/web/compilation_errors.t index 0ae6ead5b..126d33691 100644 --- a/rt/t/web/compilation_errors.t +++ b/rt/t/web/compilation_errors.t @@ -15,7 +15,6 @@ BEGIN { use HTTP::Request::Common; use HTTP::Cookies; use LWP; -use Encode; my $cookie_jar = HTTP::Cookies->new; diff --git a/rt/t/web/current_user_outdated_email.t b/rt/t/web/current_user_outdated_email.t new file mode 100644 index 000000000..51fc803c6 --- /dev/null +++ b/rt/t/web/current_user_outdated_email.t @@ -0,0 +1,41 @@ + +use strict; +use warnings; +use RT::Test tests => 39; + +my ( $url, $m ) = RT::Test->started_ok; + +$m->login(); + +my @links = ( + '/', '/Ticket/Create.html?Queue=1', + '/SelfService/Create.html?Queue=1', '/m/ticket/create?Queue=1' +); + +my $root = RT::Test->load_or_create_user( Name => 'root' ); +ok( $root->id, 'loaded root' ); +is( $root->EmailAddress, 'root@localhost', 'default root email' ); + +for my $link (@links) { + $m->get_ok($link); + $m->content_contains( '"root@localhost"', "default email in $link" ); +} + +$root->SetEmailAddress('foo@example.com'); +is( $root->EmailAddress, 'foo@example.com', 'changed to foo@example.com' ); + +for my $link (@links) { + $m->get_ok($link); + $m->content_lacks( '"root@localhost"', "no default email in $link" ); + $m->content_contains( '"foo@example.com"', "new email in $link" ); +} + +$root->SetEmailAddress('root@localhost'); +is( $root->EmailAddress, 'root@localhost', 'changed back to root@localhost' ); + +for my $link (@links) { + $m->get_ok($link); + $m->content_lacks( '"foo@example.com"', "no previous email in $link" ); + $m->content_contains( '"root@localhost"', "default email in $link" ); +} + diff --git a/rt/t/web/helpers-http-cache-headers.t b/rt/t/web/helpers-http-cache-headers.t new file mode 100644 index 000000000..1731e9d17 --- /dev/null +++ b/rt/t/web/helpers-http-cache-headers.t @@ -0,0 +1,96 @@ +use strict; +use warnings; + +# trs: I'd write a quick t/web/caching-headers.t file which loops the available +# endpoints checking for the right headers. + +use File::Find; + +BEGIN { + # Ensure that the test and server processes use the same fixed time. + use constant TIME => 1365175699; + use Test::MockTime 'set_fixed_time'; + set_fixed_time(TIME); + + use RT::Test + tests => undef, + config => "use Test::MockTime 'set_fixed_time'; set_fixed_time(".TIME.");"; +} + +my ($base, $m) = RT::Test->started_ok; +ok $m->login, 'logged in'; + +my $docroot = join '/', qw(share html); + +# find endpoints to loop over +my @endpoints = ('/NoAuth/css/print.css'); +find({ + wanted => sub { + if ( -f $_ && $_ !~ m|autohandler$| ) { + ( my $endpoint = $_ ) =~ s|^$docroot||; + push @endpoints, $endpoint; + } + }, + no_chdir => 1, +} => join '/', $docroot => 'Helpers'); + +my $ticket_id; +diag "create a ticket via the API"; +{ + my $ticket = RT::Ticket->new( RT->SystemUser ); + my ($id, $txn, $msg) = $ticket->Create( + Queue => 'General', + Subject => 'test ticket', + ); + ok $id, 'created a ticket #'. $id or diag "error: $msg"; + is $ticket->Subject, 'test ticket', 'correct subject'; + $ticket_id = $id; +} + + +my $expected; +diag "set up expected date headers"; +{ + + # expected headers + $expected = { + Autocomplete => { + 'Cache-Control' => 'max-age=120, private', + 'Expires' => 'Fri, 5 Apr 2013 15:30:19 GMT', + }, + NoAuth => { + 'Cache-Control' => 'max-age=2592000, public', + 'Expires' => 'Sun, 5 May 2013 15:28:19 GMT', + }, + default => { + 'Cache-Control' => 'no-cache', + 'Expires' => 'Fri, 5 Apr 2013 15:28:19 GMT', + }, + }; + +} + +foreach my $endpoint ( @endpoints ) { + $m->get_ok( $endpoint . "?id=${ticket_id}&Status=open&Requestor=root" ); + + my $header_key = 'default'; + if ( $endpoint =~ m|Autocomplete| ) { + $header_key = 'Autocomplete'; + } elsif ( $endpoint =~ m|NoAuth| ) { + $header_key = 'NoAuth'; + } + my $headers = $expected->{$header_key}; + + is( + $m->res->header('Cache-Control') => $headers->{'Cache-Control'}, + 'got expected Cache-Control header' + ); + + is( + $m->res->header('Expires') => $headers->{'Expires'}, + 'got expected Expires header' + ); +} + +undef $m; +done_testing; diff --git a/rt/t/web/html_template.t b/rt/t/web/html_template.t index 78b95a3b2..a2764556f 100644 --- a/rt/t/web/html_template.t +++ b/rt/t/web/html_template.t @@ -2,16 +2,16 @@ use strict; use warnings; -use RT::Test tests => 19; -use Encode; +use RT::Test tests => undef; my ( $baseurl, $m ) = RT::Test->started_ok; ok $m->login, 'logged in as root'; -use utf8; - diag('make Autoreply template a html one and add utf8 chars') if $ENV{TEST_VERBOSE}; +my $template = Encode::decode("UTF-8", "你好 éèà€"); +my $subject = Encode::decode("UTF-8", "标题"); +my $content = Encode::decode("UTF-8", "测试"); { $m->follow_link_ok( { id => 'tools-config-global-templates' }, '-> Templates' ); $m->follow_link_ok( { text => 'Autoreply' }, '-> Autoreply' ); @@ -19,20 +19,20 @@ diag('make Autoreply template a html one and add utf8 chars') $m->submit_form( form_name => 'ModifyTemplate', fields => { - Content => <<'EOF', -Subject: AutoReply: {$Ticket->Subject} + Content => <<EOF, +Subject: AutoReply: {\$Ticket->Subject} Content-Type: text/html -你好 éèà€ -{$Ticket->Subject} +$template +{\$Ticket->Subject} ------------------------------------------------------------------------- -{$Transaction->Content()} +{\$Transaction->Content()} EOF }, ); $m->content_like( qr/Content updated/, 'content is changed' ); - $m->content_contains( '你好', 'content is really updated' ); + $m->content_contains( $template, 'content is really updated' ); } diag('create a ticket to see the autoreply mail') if $ENV{TEST_VERBOSE}; @@ -42,17 +42,16 @@ diag('create a ticket to see the autoreply mail') if $ENV{TEST_VERBOSE}; $m->submit_form( form_name => 'TicketCreate', - fields => { Subject => '标题', Content => '<h1>测试</h1>', + fields => { Subject => $subject, Content => "<h1>$content</h1>", ContentType => 'text/html' }, ); $m->content_like( qr/Ticket \d+ created/i, 'created the ticket' ); $m->follow_link( text => 'Show' ); - $m->content_contains( '你好', 'html has 你好' ); - $m->content_contains( 'éèà€', 'html has éèà€' ); - $m->content_contains( '标题', - 'html has ticket subject 标题' ); - $m->content_contains( '<h1>测试</h1>', - 'html has ticket html content 测试' ); + $m->content_contains( $template, "html has $template" ); + $m->content_contains( $subject, + "html has ticket subject $subject" ); + $m->content_contains( "<h1>$content</h1>", + "html has ticket html content $content" ); } diag('test real mail outgoing') if $ENV{TEST_VERBOSE}; @@ -61,11 +60,12 @@ diag('test real mail outgoing') if $ENV{TEST_VERBOSE}; # $mail is utf8 encoded my ($mail) = RT::Test->fetch_caught_mails; - $mail = decode_utf8 $mail; - like( $mail, qr/你好.*你好/s, 'mail has éèà€' ); - like( $mail, qr/éèà€.*éèà€/s, 'mail has éèà€' ); - like( $mail, qr/标题.*标题/s, 'mail has ticket subject 标题' ); - like( $mail, qr/测试.*测试/s, 'mail has ticket content 测试' ); - like( $mail, qr!<h1>测试</h1>!, 'mail has ticket html content 测试' ); + $mail = Encode::decode("UTF-8", $mail ); + like( $mail, qr/$template.*$template/s, 'mail has template content $template twice' ); + like( $mail, qr/$subject.*$subject/s, 'mail has ticket subject $sujbect twice' ); + like( $mail, qr/$content.*$content/s, 'mail has ticket content $content twice' ); + like( $mail, qr!<h1>$content</h1>!, 'mail has ticket html content <h1>$content</h1>' ); } +undef $m; +done_testing; diff --git a/rt/t/web/login.t b/rt/t/web/login.t new file mode 100644 index 000000000..d0213c373 --- /dev/null +++ b/rt/t/web/login.t @@ -0,0 +1,133 @@ +use strict; +use warnings; + +use RT::Test tests => 34; + +my ( $baseurl, $m ) = RT::Test->started_ok; + +my $ticket = RT::Test->create_ticket( + Subject => 'ticket_foo', + Queue => 'General', +); + +my ( $user, $pass ) = ( 'root', 'password' ); + +diag "normal login"; +{ + $m->get($baseurl); + $m->title_is('Login'); + is( $m->uri, $baseurl, "right url" ); + + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => 'wrong pass', + } + ); + $m->content_contains( "Your username or password is incorrect", + 'login error message' ); + $m->warning_like( qr/FAILED LOGIN for root/, + "got failed login warning" ); + + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => $pass, + } + ); + + $m->title_is( 'RT at a glance', 'logged in' ); + + $m->follow_link_ok( { text => 'Logout' }, 'follow logout' ); + $m->title_is( 'Logout', 'logout' ); +} + +diag "tangent login"; + +{ + $m->get( $baseurl . '/Ticket/Display.html?id=1' ); + $m->title_is('Login'); + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => $pass, + } + ); + like( $m->uri, qr{/Ticket/Display\.html}, 'normal ticket page' ); + $m->follow_link_ok( { text => 'Logout' }, 'follow logout' ); +} + +diag "mobile login with not mobile client"; +{ + $m->get( $baseurl . '/m' ); + is( $m->uri, $baseurl . '/m', "right url" ); + $m->content_contains( "/m/index.html?NotMobile=1", 'mobile login' ); + + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => 'wrong pass', + } + ); + $m->content_contains( "Your username or password is incorrect", + 'login error message' ); + $m->warning_like( qr/FAILED LOGIN for root/, + "got failed login warning" ); + + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => $pass, + } + ); + like( $m->uri, qr{\Q$baseurl/m\E}, "mobile url" ); + $m->follow_link_ok( { text => 'Logout' }, 'follow logout' ); + $m->content_contains( "/m/index.html?NotMobile=1", + 'back to mobile login page' ); + $m->content_lacks( 'Logout', 'really logout' ); +} + + +diag "mobile normal login"; +{ + + # default browser in android 2.3.6 + $m->agent( +"Mozilla/5.0 (Linux; U; Android 2.3.6; en-us; Nexus One Build/GRK39F) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1" + ); + + $m->get($baseurl); + is( $m->uri, $baseurl, "right url" ); + $m->content_contains( "/m/index.html?NotMobile=1", 'mobile login' ); + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => $pass, + } + ); + is( $m->uri, $baseurl . '/m/', "mobile url" ); + $m->follow_link_ok( { text => 'Logout' }, 'follow logout' ); + $m->content_contains( "/m/index.html?NotMobile=1", 'back to mobile login page' ); + $m->content_lacks( 'Logout', 'really logout' ); +} + +diag "mobile tangent login"; +{ + $m->get( $baseurl . '/Ticket/Display.html?id=1' ); + $m->content_contains( "/m/index.html?NotMobile=1", 'mobile login' ); + $m->submit_form( + form_id => 'login', + fields => { + user => $user, + pass => $pass, + } + ); + like( $m->uri, qr{/m/ticket/show}, 'mobile ticket page' ); +} + diff --git a/rt/t/web/offline_messages_utf8.t b/rt/t/web/offline_messages_utf8.t index 4518c7b7a..4cf6954bd 100644 --- a/rt/t/web/offline_messages_utf8.t +++ b/rt/t/web/offline_messages_utf8.t @@ -2,7 +2,6 @@ use strict; use warnings; use RT::Test tests => 8; -use Encode; use RT::Ticket; my ( $url, $m ) = RT::Test->started_ok; @@ -35,7 +34,7 @@ EOF fields => { string => $template, }, button => 'UpdateTickets', ); - my $content = encode 'utf8', $m->content; + my $content = Encode::encode("UTF-8", $m->content); ok( $content =~ m/申請單 #(\d+) 成功新增於 'General' 表單/, 'message is shown right' ); $ticket_id = $1; } @@ -55,7 +54,7 @@ EOF button => 'UpdateTickets', ); - my $content = encode 'utf8', $m->content; + my $content = Encode::encode("UTF-8", $m->content); ok( $content =~ qr/主題\s*的值從\s*'test message'\s*改為\s*'test message update'/, diff --git a/rt/t/web/offline_utf8.t b/rt/t/web/offline_utf8.t index c317a4616..aab3049a3 100644 --- a/rt/t/web/offline_utf8.t +++ b/rt/t/web/offline_utf8.t @@ -2,14 +2,11 @@ use strict; use warnings; use RT::Test tests => 9; -use utf8; - -use Encode; use RT::Ticket; my $file = File::Spec->catfile( RT::Test->temp_directory, 'template' ); open my $fh, '>', $file or die $!; -my $template = <<EOF; +my $template = Encode::decode("UTF-8",<<EOF); ===Create-Ticket: ticket1 Queue: General Subject: 标题 @@ -19,7 +16,7 @@ Content: ENDOFCONTENT EOF -print $fh $template; +print $fh Encode::encode("UTF-8",$template); close $fh; my ( $url, $m ) = RT::Test->started_ok; @@ -33,7 +30,7 @@ $m->submit_form( button => 'Parse', ); -$m->content_contains( '这是正文', 'content is parsed right' ); +$m->content_contains( Encode::decode("UTF-8",'这是正文'), 'content is parsed right' ); $m->submit_form( form_name => 'TicketUpdate', @@ -48,9 +45,9 @@ my ( $ticket_id ) = $m->content =~ /Ticket (\d+) created/; my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Load( $ticket_id ); -is( $ticket->Subject, '标题', 'subject in $ticket is right' ); +is( $ticket->Subject, Encode::decode("UTF-8",'标题'), 'subject in $ticket is right' ); $m->goto_ticket($ticket_id); -$m->content_contains( '这是正文', +$m->content_contains( Encode::decode("UTF-8",'这是正文'), 'content is right in ticket display page' ); diff --git a/rt/t/web/plugin-overlays.t b/rt/t/web/plugin-overlays.t new file mode 100644 index 000000000..fec458964 --- /dev/null +++ b/rt/t/web/plugin-overlays.t @@ -0,0 +1,30 @@ +use strict; +use warnings; + +BEGIN { + use Test::More; + plan skip_all => "Testing the rt-server init sequence in isolation requires Apache" + unless ($ENV{RT_TEST_WEB_HANDLER} || '') =~ /^apache/; +} + +use JSON qw(from_json); + +use RT::Test + tests => undef, + plugins => ["Overlays"]; + +my ($base, $m) = RT::Test->started_ok; + +# Check that the overlay was actually loaded +$m->get_ok("$base/overlay_loaded"); +is $m->content, "yes", "Plugin's RT/User_Local.pm was loaded"; + +# Check accessible is correct and doesn't need to be rebuilt from overlay +$m->get_ok("$base/user_accessible"); +ok $m->content, "Received some content"; + +my $info = from_json($m->content) || {}; +ok $info->{Comments}{public}, "User.Comments is marked public via overlay"; + +undef $m; +done_testing; diff --git a/rt/t/web/query_builder.t b/rt/t/web/query_builder.t index 13cd1b5d0..3589c381a 100644 --- a/rt/t/web/query_builder.t +++ b/rt/t/web/query_builder.t @@ -3,7 +3,6 @@ use warnings; use HTTP::Request::Common; use HTTP::Cookies; use LWP; -use Encode; use RT::Test tests => 70; my $cookie_jar = HTTP::Cookies->new; diff --git a/rt/t/web/rest-non-ascii-subject.t b/rt/t/web/rest-non-ascii-subject.t index 8b870a8b1..0d3e14dfb 100644 --- a/rt/t/web/rest-non-ascii-subject.t +++ b/rt/t/web/rest-non-ascii-subject.t @@ -3,8 +3,6 @@ use strict; use warnings; use RT::Test tests => 9; -use Encode; -# \x{XX} where XX is less than 255 is not treated as unicode code point my $subject = Encode::decode('latin1', "Sujet accentu\x{e9}"); my $text = Encode::decode('latin1', "Contenu accentu\x{e9}"); @@ -32,8 +30,7 @@ Text: $text"; $m->post("$baseurl/REST/1.0/ticket/new", [ user => 'root', pass => 'password', -# error message from HTTP::Message: content must be bytes - content => Encode::encode_utf8($content), + content => Encode::encode( "UTF-8", $content), ], Content_Type => 'form-data' ); my ($id) = $m->content =~ /Ticket (\d+) created/; diff --git a/rt/t/web/sidebyside_layout.t b/rt/t/web/sidebyside_layout.t new file mode 100644 index 000000000..88ea10cc5 --- /dev/null +++ b/rt/t/web/sidebyside_layout.t @@ -0,0 +1,45 @@ +use strict; +use warnings; +use RT::Test tests => 11; + +RT->Config->Set( UseSideBySideLayout => 0 ); + +my $root = RT::Test->load_or_create_user( Name => 'root', ); +my ( $status, $msg ) = $root->SetPreferences( + $RT::System => { + %{ $root->Preferences($RT::System) || {} }, 'UseSideBySideLayout' => 1 + } +); +ok( $status, 'use side by side layout for root' ); + +my $user_a = RT::Test->load_or_create_user( + Name => 'user_a', + Password => 'password', +); +ok( $user_a->id, 'created user_a' ); + +ok( + RT::Test->set_rights( + { + Principal => $user_a, + Right => ['CreateTicket'] + }, + ), + 'granted user_a the right of CreateTicket' +); + +my ( $url, $m ) = RT::Test->started_ok; +$m->login; +$m->get_ok( $url . '/Ticket/Create.html?Queue=1', "root's ticket create page" ); +$m->content_like( qr/<body [^>]*class="[^>"]*\bsidebyside\b/, + 'found sidebyside css for root' ); + +my $m_a = RT::Test::Web->new; +ok $m_a->login( 'user_a', 'password' ), 'logged in as user_a'; +$m_a->get_ok( $url . '/Ticket/Create.html?Queue=1', + "user_a's ticket create page" ); +$m_a->content_unlike( + qr/<body [^>]*class="[^>"]*\bsidebyside\b/, + "didn't find sidebyside class for user_a" +); + diff --git a/rt/t/web/ticket-create-utf8.t b/rt/t/web/ticket-create-utf8.t index bebc57b51..107e41d71 100644 --- a/rt/t/web/ticket-create-utf8.t +++ b/rt/t/web/ticket-create-utf8.t @@ -4,8 +4,6 @@ use warnings; use RT::Test tests => 43; -use Encode; - my $ru_test = "\x{442}\x{435}\x{441}\x{442}"; my $ru_support = "\x{43f}\x{43e}\x{434}\x{434}\x{435}\x{440}\x{436}\x{43a}\x{430}"; diff --git a/rt/t/web/ticket_txn_subject.t b/rt/t/web/ticket_txn_subject.t new file mode 100644 index 000000000..a43f05d96 --- /dev/null +++ b/rt/t/web/ticket_txn_subject.t @@ -0,0 +1,85 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my ($base, $m) = RT::Test->started_ok; +ok $m->login, 'logged in'; + +my @tickets; + +diag "create a ticket via the API"; +{ + my $ticket = RT::Ticket->new( RT->SystemUser ); + my ($id, $txn, $msg) = $ticket->Create( + Queue => 'General', + Subject => Encode::decode("UTF-8",'bad subject‽'), + ); + ok $id, 'created a ticket #'. $id or diag "error: $msg"; + is $ticket->Subject, Encode::decode("UTF-8",'bad subject‽'), 'correct subject'; + push @tickets, $id; +} + +diag "create a ticket via the web"; +{ + $m->submit_form_ok({ + form_name => "CreateTicketInQueue", + fields => { Queue => 1 }, + }, 'create ticket in Queue'); + $m->submit_form_ok({ + with_fields => { + Subject => Encode::decode("UTF-8",'bad subject #2‽'), + }, + }, 'create ticket'); + $m->content_contains(Encode::decode("UTF-8",'bad subject #2‽'), 'correct subject'); + push @tickets, 2; +} + +diag "create a ticket via the web without a unicode subject"; +{ + $m->submit_form_ok({ + with_fields => { Queue => 1 }, + }, 'create ticket in Queue'); + $m->submit_form_ok({ + with_fields => { + Subject => 'a fine subject #3', + }, + }, 'create ticket'); + $m->content_contains('a fine subject #3', 'correct subject'); + push @tickets, 3; +} + +for my $tid (@tickets) { + diag "ticket #$tid"; + diag "add a reply which adds to the subject, but without an attachment"; + { + $m->goto_ticket($tid); + $m->follow_link_ok({ id => 'page-actions-reply' }, "Actions -> Reply"); + $m->submit_form_ok({ + with_fields => { + UpdateSubject => Encode::decode("UTF-8",'bad subject‽ without attachment'), + UpdateContent => 'testing unicode txn subjects', + }, + button => 'SubmitTicket', + }, 'submit reply'); + $m->content_contains(Encode::decode("UTF-8",'bad subject‽ without attachment'), "found txn subject"); + } + + diag "add a reply which adds to the subject with an attachment"; + { + $m->goto_ticket($tid); + $m->follow_link_ok({ id => 'page-actions-reply' }, "Actions -> Reply"); + $m->submit_form_ok({ + with_fields => { + UpdateSubject => Encode::decode("UTF-8",'bad subject‽ with attachment'), + UpdateContent => 'testing unicode txn subjects', + Attach => RT::Test::get_relocatable_file('bpslogo.png', '..', 'data'), + }, + button => 'SubmitTicket', + }, 'submit reply'); + $m->content_contains(Encode::decode("UTF-8",'bad subject‽ with attachment'), "found txn subject"); + } +} + +undef $m; +done_testing; diff --git a/rt/t/web/user_update.t b/rt/t/web/user_update.t index c0e9e5264..54139d797 100644 --- a/rt/t/web/user_update.t +++ b/rt/t/web/user_update.t @@ -1,6 +1,5 @@ use strict; use warnings; -use utf8; use RT::Test tests => undef; my ( $url, $m ) = RT::Test->started_ok; @@ -10,7 +9,7 @@ $m->follow_link_ok({text => 'About me'}); $m->submit_form_ok({ with_fields => { Lang => 'ja'} }, "Change to Japanese"); $m->text_contains("Lang changed from (no value) to 'ja'"); -$m->text_contains("実名", "Page content is japanese"); +$m->text_contains(Encode::decode("UTF-8","実名"), "Page content is japanese"); # we only changed one field, and it wasn't the default, so this feedback is # spurious and annoying @@ -22,7 +21,7 @@ $m->submit_form_ok({ with_fields => { Lang => 'en_us'} }, # This message shows up in Japanese # $m->text_contains("Lang changed from 'ja' to 'en_us'"); -$m->text_contains("Langは「'ja'」から「'en_us'」に変更されました"); +$m->text_contains(Encode::decode("UTF-8","Langは「'ja'」から「'en_us'」に変更されました")); $m->text_contains("Real Name", "Page content is english"); # Check for a lack of spurious updates @@ -32,12 +31,11 @@ $m->content_lacks("That is already the current value"); $m->submit_form_ok({ with_fields => { Lang => 'ja'} }, "Back briefly to Japanese"); $m->text_contains("Lang changed from 'en_us' to 'ja'"); -$m->text_contains("実名", "Page content is japanese"); +$m->text_contains(Encode::decode("UTF-8","実名"), "Page content is japanese"); $m->submit_form_ok({ with_fields => { Lang => ''} }, "And set to the default"); -$m->text_contains("Langは「'ja'」から「(値なし)」に変更されました"); +$m->text_contains(Encode::decode("UTF-8","Langは「'ja'」から「(値なし)」に変更されました")); $m->text_contains("Real Name", "Page content is english"); undef $m; - done_testing; |