653 lines
20 KiB
Perl
653 lines
20 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Visit the Trouble Ticket Express home page for release notes and setup info
|
|
# http://www.troubleticketexpress.com
|
|
#
|
|
# COPYRIGHT: 2002-2006, United Web Coders.
|
|
# http://www.unitedwebcoders.com
|
|
#
|
|
# $Revision: 287 $
|
|
# $Date: 2006-10-17 16:00:49 +0400 (Tue, 17 Oct 2006) $
|
|
#
|
|
my $configfile;
|
|
my $defaultcmd = 'newticket';
|
|
|
|
# ==== NOTHING TO EDIT BELOW THIS LINE. PLS DO NOT CROSS =======================
|
|
|
|
my $version = '2.22';
|
|
my $REVISION;
|
|
|
|
BEGIN {
|
|
$REVISION = '$Revision: 287 $';
|
|
if ($REVISION =~ /(\d+)/) {
|
|
$REVISION = $1;
|
|
}
|
|
my $sd = _findsd() || '.';
|
|
$sd =~ /(.*)/;
|
|
$sd = $1;
|
|
my $path = $ENV{PATH};
|
|
$path =~ /(.*)/;
|
|
$ENV{PATH} = $1;
|
|
eval "use lib '$sd'";
|
|
if ($@) {
|
|
_fatalbegin($@);
|
|
exit 0;
|
|
}
|
|
if ($sd ne '.') {
|
|
chdir $sd;
|
|
}
|
|
eval "use TTXConfig";
|
|
if ($@) {
|
|
if (-f "$sd/TTXConfig.pm") {
|
|
_fatalbegin($@);
|
|
} else {
|
|
_fatalbegin("Incomplete package. Please upload all *.cgi and *.pm files to your web server");
|
|
}
|
|
exit 0;
|
|
}
|
|
sub _fatalbegin {
|
|
print <<EOT;
|
|
Content-type: text/html
|
|
|
|
<html>
|
|
<body>
|
|
<br><br>
|
|
<font color=red><b>Fatal error:</b></font>
|
|
$_[0]
|
|
<br><br>
|
|
<a href="http://ttx.helpdeskconnect.com"><b>Trouble Ticket Express Help Desk</b></a>
|
|
</body>
|
|
</html>
|
|
EOT
|
|
}
|
|
sub _findsd {
|
|
my $dir = $ENV{'SCRIPT_FILENAME'};
|
|
$dir = $ENV{'PATH_TRANSLATED'} if $ENV{'PATH_TRANSLATED'} ne undef;
|
|
$dir = $ENV{'pathTranslated'} if $ENV{'pathTranslated'} ne undef;
|
|
return $ENV{'PWD'} if $dir eq undef;
|
|
my @path = split(/\/|\\/, $dir);
|
|
pop(@path);
|
|
$dir = join("\/", @path);
|
|
return $dir;
|
|
}
|
|
}
|
|
|
|
use strict;
|
|
use CGI;
|
|
use TTXConfig;
|
|
use TTXData;
|
|
require TTXSession;
|
|
require TTXUser;
|
|
require TTXDictionary;
|
|
eval "require TTXFile";
|
|
TTXData::set('ISPRO', 1) if $@ eq undef;
|
|
|
|
# please feel free to uncomment the following line in order to get rid of
|
|
# bogus "usage of uninitialized variable" in your error log file, but
|
|
# make sure your Perl supports the 'no warnings' pragma
|
|
|
|
# no warnings 'uninitialized';
|
|
|
|
#
|
|
# Global vars
|
|
#
|
|
my $cfg;
|
|
my $query;
|
|
my $user;
|
|
my %data;
|
|
my $usecache = 0;
|
|
my $originalcookie;
|
|
|
|
my $cmddef = {
|
|
login => { action => 'TTXLogin::login', access => 0 },
|
|
ticket => { action => 'TTXTicket::ticket', access => 0 },
|
|
claim => { action => 'TTXTicket::claim', access => 1 },
|
|
keyfinder => { action => 'TTXTicket::keyform', access => 0, template => 'keyform.html' },
|
|
keyform => { action => 'TTXTicket::keyform', access => 0 },
|
|
newticket => { action => 'TTXTicket::newticket', access => 0 },
|
|
confirmnew => { action => 'TTXTicket::confirmnew', access => 0 },
|
|
markuphelp => { action => 'TTXMarkup::help', access => 0, noheader => 1, template => 'markuphelp.html' },
|
|
answerlib => { action => 'TTXOrder::answerlib', access => 1, noheader => 1, template => 'orderalib.html' },
|
|
newanswer => { action => 'TTXAnswerLib::newanswer', access => 1, noheader => 1 },
|
|
delanswer => { action => 'TTXAnswerLib::delanswer', access => 1, noheader => 1 },
|
|
editanswer => { action => 'TTXAnswerLib::editanswer', access => 1, noheader => 1, template => 'newanswer.html' },
|
|
ticketed => { action => 'TTXTickEd::ticketed', access => 1, noheader => 1, template => 'ticketed.html' },
|
|
helpdesk => { action => 'TTXDesk::helpdesk', access => 1 },
|
|
reports => { action => 'TTXReports::main', access => 1 },
|
|
survey => { action => 'TTXSurvey::survey', access => 0 },
|
|
cfrmsurvey => { action => 'TTXSurvey::confirm', access => 0 },
|
|
annotate => { action => 'TTXPrint::annotate', access => 0, noheader => 1 },
|
|
'print' => { action => 'TTXPrint::print', access => 0, noheader => 1 },
|
|
preview => { action => 'TTXPreview::preview', access => 0, noheader => 1 },
|
|
groupcommand => { action => 'TTXGrpCmd::do', access => 1 },
|
|
msgedit => { action => 'TTXMsgEdit::edit', access => 1, noheader => 1 },
|
|
msgdel => { action => 'TTXMsgEdit::del', access => 1, noheader => 1 },
|
|
};
|
|
eval "require TTXAnswerLib";
|
|
if ($@ eq undef) {
|
|
$cmddef->{answerlib}->{action} = 'TTXAnswerLib::answerlib';
|
|
$cmddef->{answerlib}->{template} = 'answerlib.html';
|
|
}
|
|
eval "use TTXMyTickets";
|
|
if ($@ eq undef) {
|
|
$cmddef->{mytickets}->{action} = 'TTXMyTickets::mytickets';
|
|
$cmddef->{mytickets}->{template} = 'helpdesk.html';
|
|
}
|
|
eval "require TTXDashBoard";
|
|
if ($@ eq undef) {
|
|
$cmddef->{showitem}->{action} = 'TTXDashBoard::showitem';
|
|
$cmddef->{showitem}->{noheader} = 1;
|
|
$cmddef->{showitem}->{access} = 1;
|
|
$cmddef->{dashboard}->{action} = 'TTXDashBoard::dashboard';
|
|
$cmddef->{dashboard}->{access} = 1;
|
|
}
|
|
#
|
|
# Read config
|
|
#
|
|
if ($configfile eq undef) {
|
|
$configfile = 'ttxcfg.cgi';
|
|
my $sd = scriptdir();
|
|
$configfile = "$sd/ttxcfg.cgi" if $sd ne undef;
|
|
}
|
|
$cfg = TTXConfig->new($configfile);
|
|
if ($cfg->error()) {
|
|
print "Content-type: text/html\n\n";
|
|
fatalerror($cfg->errortext())
|
|
}
|
|
if ($cfg->get('cfgref') ne undef) {
|
|
if (!$cfg->load($cfg->get('cfgref'))) {
|
|
print "Content-type: text/html\n\n";
|
|
fatalerror($cfg->errortext());
|
|
}
|
|
}
|
|
if ($cfg->get('order1256')) {
|
|
$cmddef->{ticket}->{template} = 'ticket1256.html';
|
|
}
|
|
if ($cfg->get('validate') ne undef) {
|
|
$cmddef->{confirmnew}->{template} = 'confirmnewvalidate.html';
|
|
}
|
|
TTXData::set('CONFIG', $cfg);
|
|
if ($cfg->get('cookiename') eq undef) {
|
|
$cfg->set('cookiename', 'TTXPRESS');
|
|
}
|
|
readglobals();
|
|
if ($cfg->get('httphost') ne $ENV{HTTP_HOST} || $cfg->get('scriptname') ne $ENV{SCRIPT_NAME}) {
|
|
$cfg->set('httphost', $ENV{HTTP_HOST});
|
|
$cfg->set('scriptname', $ENV{SCRIPT_NAME});
|
|
$cfg->save();
|
|
}
|
|
if ($cfg->get('ttx.version') eq undef || $cfg->get('ttx.version') < $version) {
|
|
eval 'use TTXUpgrade';
|
|
if ($@ ne undef) {
|
|
print "Content-type: text/html\n\n";
|
|
fatalerror('TTXUpgrade.pm not found. Please upload the file to the scripts directory.');
|
|
}
|
|
my $err = TTXUpgrade::upgrade($cfg);
|
|
if ($err ne undef) {
|
|
print "Content-type: text/html\n\n";
|
|
fatalerror("Error during upgrade: $err");
|
|
}
|
|
}
|
|
if ($cfg->get('internaldesk')) {
|
|
$cmddef->{newticket}->{access} = 1;
|
|
$defaultcmd = 'helpdesk';
|
|
}
|
|
#
|
|
# Stop here if database upgrade is in progress
|
|
#
|
|
if ($cfg->get('dbupdate') > 0) {
|
|
if ((time() - $cfg->get('dbupdate')) > 120) {
|
|
# the upgrade process died
|
|
$cfg->set('dbupdate', '');
|
|
$cfg->save();
|
|
} else {
|
|
print "Content-type: text/html\n\n";
|
|
upgrademsg();
|
|
exit;
|
|
}
|
|
}
|
|
#
|
|
# Parse input
|
|
#
|
|
my $tmpdir = $cfg->get('basedir').'/tmp';
|
|
if (! -d $tmpdir) {
|
|
mkdir($tmpdir, 0777);
|
|
}
|
|
if (-d $tmpdir && -w $tmpdir) {
|
|
$ENV{TMPDIR} = $tmpdir if $ENV{TMPDIR} eq undef || ! -d $ENV{TMPDIR} || ! -w $ENV{TMPDIR};
|
|
}
|
|
eval '$query = new CGI';
|
|
if ($@ ne undef) {
|
|
warn "New CGI failed, error: $@";
|
|
print <<EOT;
|
|
Content-type: text/html
|
|
|
|
<html>
|
|
<body>
|
|
<br><br><br><br>
|
|
<center>
|
|
<b><font color=red>The file you are trying to upload is too big</font>
|
|
<br><br>
|
|
Please use your browser 'Back' button to return to previous page.
|
|
</center>
|
|
</body>
|
|
</html>
|
|
EOT
|
|
exit;
|
|
}
|
|
if ($query eq undef) {
|
|
print "Content-type: text/html\n\n";
|
|
exit;
|
|
}
|
|
if ($query->param('cmd') eq 'file' && TTXData::get('ISPRO')) {
|
|
TTXFile::download($query->param('fid'), $query->param('fn'));
|
|
exit;
|
|
}
|
|
if ($query->param('cmd') eq 'img') {
|
|
eval "use TTXImage";
|
|
if (!$@) {
|
|
TTXImage::show($query->param('fid'), $query->param('fid'));
|
|
}
|
|
exit;
|
|
}
|
|
#
|
|
# Create User object if session id provided
|
|
#
|
|
print "Content-type: text/html\n"; # Single new-line, as more headers may follow
|
|
my $savestate = $|;
|
|
$|=1;
|
|
$|=$savestate;
|
|
if ($query->param('sid') ne undef) {
|
|
my $session = TTXSession->new($query->param('sid'));
|
|
if ($session ne undef && $session->get('login') ne undef) {
|
|
if ($session->expired()) {
|
|
$session->logout();
|
|
$query->param(-name => 'sid', -value => '');
|
|
$query->param(-name => 'cmd', -value => 'helpdesk');
|
|
login('[%Your session expired%]');
|
|
} else {
|
|
$session->refresh();
|
|
$user = TTXUser->new($session->get('login'));
|
|
if ($user eq undef || $user->get('login') eq undef) {
|
|
$query->param(-name => 'sid', -value => '');
|
|
$user = undef;
|
|
} elsif ($query->param('cmd') eq 'logout') {
|
|
$session->logout();
|
|
$query->param(-name => 'sid', -value => '');
|
|
$query->param(-name => 'cmd', -value => '');
|
|
login('[%You were logged out%]');
|
|
$user = undef;
|
|
} else {
|
|
$user->set('session', $session);
|
|
}
|
|
}
|
|
} else {
|
|
$query->param(-name => 'sid', -value => '');
|
|
}
|
|
} else {
|
|
if ($cfg->get('quicklink') && $query->param('cmd') eq 'helpdesk') {
|
|
my $oper = $query->param('o');
|
|
my $tk = $query->param('tk');
|
|
my $p = $query->param('p');
|
|
if ($oper ne undef && $tk =~ /^\d+Z/ && $p ne undef) {
|
|
my $u = TTXUser->new($oper);
|
|
if ($u ne undef && $u->{passwd} ne undef) {
|
|
$tk =~ s/Z.*//;
|
|
my $salt = $tk;
|
|
$salt = $salt % 100;
|
|
$salt = "0$salt" if $salt < 10;
|
|
$p = "$salt$p";
|
|
if ($p eq crypt($u->{passwd}.$tk, $p)) {
|
|
$query->param(-name => 'cmd', -value => 'login');
|
|
$query->param(-name => 'nextcmd', -value => 'helpdesk');
|
|
$query->param(-name => 'login', -value => $oper);
|
|
$query->param(-name => 'passwd', -value => $u->{passwd});
|
|
$query->param(-name => 'dologin', -value => 1);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($query->param('cmd') eq 'logout') {
|
|
$query->param(-name => 'cmd', -value => '');
|
|
login("You were logged out");
|
|
}
|
|
if ($user ne undef) {
|
|
$cfg->set('_USER', $user);
|
|
$data{USERID} = $user->{login};
|
|
if ($user->get('ro')) {
|
|
$cmddef->{ticket}->{template} = 'roticket.html';
|
|
}
|
|
}
|
|
if ($cfg->get('HTMLBASEWIDTH') eq undef) {
|
|
$cfg->set('HTMLBASEWIDTH', 700);
|
|
$cfg->save();
|
|
}
|
|
my $charset = TTXDictionary::translate('CHARSET');
|
|
if ($charset ne undef && $charset ne 'CHARSET' && $charset ne $cfg->get('charset')) {
|
|
$cfg->set('charset', $charset);
|
|
$cfg->save();
|
|
}
|
|
if ($query->param('cmd') eq undef) {
|
|
$query->param(-name => 'cmd', -value => $defaultcmd);
|
|
}
|
|
#
|
|
# Consult cache
|
|
#
|
|
my $pagesignature;
|
|
if ($cfg->get('usecache')) {
|
|
eval "use TTXCache";
|
|
if ($@ eq undef) {
|
|
$usecache = 1;
|
|
TTXData::set('_USECACHE', 1);
|
|
my $pgid = TTXCache::hit($cfg, $query);
|
|
$pagesignature = TTXCache::signature($query);
|
|
my $sessig;
|
|
if ($query->param('sid') ne undef) {
|
|
my $session = TTXSession->new($query->param('sid'));
|
|
if ($session ne undef && $user ne undef &&
|
|
$session->get('login') ne undef &&
|
|
$user->{login} eq $session->get('login')) {
|
|
$sessig = $session->get('signature');
|
|
$session->set('signature', $pagesignature);
|
|
$session->save();
|
|
}
|
|
}
|
|
if ($pgid) {
|
|
my $pgout = TTXCache::page($cfg, $pgid);
|
|
if ($pgout ne undef) {
|
|
print "\n$pgout";
|
|
TTXCache::logit('H|'.$query->param('cmd').'|'.length($pgout));
|
|
exit;
|
|
}
|
|
} else {
|
|
TTXCache::logit('M|'.$query->param('cmd'));
|
|
}
|
|
}
|
|
}
|
|
#
|
|
# Execute command
|
|
#
|
|
command($query->param('cmd'));
|
|
my $cfgvars = $cfg->ashash();
|
|
foreach my $key (keys %{$cfgvars}) {
|
|
$data{"CONFIG_".uc $key} = $cfgvars->{$key};
|
|
}
|
|
foreach my $key (keys %ENV) {
|
|
$data{"ENV_".uc $key} = $ENV{$key};
|
|
}
|
|
foreach my $key ($query->param) {
|
|
$data{"INPUT_".$key} = $query->param($key);
|
|
if ($key ne 'problem') {
|
|
$data{"INPUT_".$key} =~ s/"/"/g;
|
|
} else {
|
|
$data{"INPUT_".$key} =~ s/</</g;
|
|
}
|
|
}
|
|
if (defined $cmddef->{dashboard} && $cfg->get('_USER') ne undef) {
|
|
$data{DASHBOARDLINK} = "<a href=\"$ENV{SCRIPT_NAME}?cmd=dashboard&sid=".$query->param('sid').
|
|
"&style=".$query->param('style').'">[%Dashboard%]</a> |';
|
|
}
|
|
if ($query->param('checkupdate')) {
|
|
$data{CHECKUPDATE} = "<a href=\"http://www.troubleticketexpress.com\"><img border=0 src=\"http://www.troubleticketexpress.com/cgi-bin/ttx/checkupdate.cgi?$version\"></a>";
|
|
}
|
|
$data{VERSION} = "$version.$REVISION";
|
|
if ($cfg->get('dbmode') eq 'mysql') {
|
|
$data{ISPRO} .= 'MySQL Edition';
|
|
} elsif ($cfg->get('dbmode') eq 'mssql') {
|
|
$data{ISPRO} .= 'SQL Server Edition';
|
|
} else {
|
|
$data{ISPRO} .= 'Standard Edition';
|
|
my $u = $cfg->get('_USER');
|
|
# if ($u ne undef && $u->{login} eq 'admin') {
|
|
$data{ISPRO} .= ', upgrade to <a href="sqlsetup.cgi">MySQL</a> or '.
|
|
'<a href="mssqlsetup.cgi">SQL Server</a> edition.'
|
|
# }
|
|
}
|
|
$data{HTMLBASEWIDTH} = $cfg->get('HTMLBASEWIDTH');
|
|
$data{HELPDESKCMD} = ($cfg->get('_USER') ne undef) ? 'helpdesk':'ticket';
|
|
if ($query->param('cmd') eq 'mytickets' ||
|
|
($query->param('cmd') eq 'ticket' && $query->param('emailkey') ne undef && $query->param('sid') eq undef)) {
|
|
$data{HELPDESKCMD} = 'mytickets&emailkey=' . $query->param('emailkey');
|
|
}
|
|
if ($cfg->get('_USER') ne undef) {
|
|
my $u = $cfg->get('_USER');
|
|
$data{USERID} = $u->{login};
|
|
$data{USERFNAME} = $u->{fname};
|
|
$data{USERLNAME} = $u->{lname};
|
|
$data{LOGGEDAS} = TTXDictionary::translate('Logged as').' '.$u->{fname}.' '.$u->{lname};
|
|
if ($cfg->get('dbmode') =~ /sql/ && $cfg->get('dbschema') < 2.19) {
|
|
$data{ISPRO} .= ' <font color=red><b>NOTE:</b></font> <a href="sqlupgrade.cgi"><b>Database upgrade required.</b></a>';
|
|
} elsif ($cfg->get('dbmode') =~ /sql/ && $cfg->get('dbschema') < 2.22) {
|
|
$data{ISPRO} .= ' <font color=red><b>NOTE:</b></font> <a href="sqlupgrade222.cgi"><b>Database upgrade required.</b></a>';
|
|
}
|
|
}
|
|
if ($cfg->get('_USER') ne undef) {
|
|
my $uid = $cfg->get('_USER')->get('login');
|
|
if ($cfg->get('grant.reports') eq undef || grep(/^$uid$/, split(/,/,$cfg->get('grant.reports')))) {
|
|
$data{LOGINLOGOUT} .= "<a href=\"$ENV{SCRIPT_NAME}?cmd=reports&sid=".
|
|
$query->param('sid')."&style=".$query->param('style').'">[%Reports%]</a> | ';
|
|
}
|
|
}
|
|
if (!$cfg->get('nologinlink')) {
|
|
$data{LOGINLOGOUT} .= "<a href=\"$ENV{SCRIPT_NAME}?cmd=".(($cfg->get('_USER') ne undef) ? 'logout':'login').
|
|
"&sid=".$query->param('sid')."&style=".$query->param('style')."\">".(($cfg->get('_USER') ne undef) ? '[%Logout%]':'[%Login%]').
|
|
"</a>";
|
|
}
|
|
if ($cfg->get('home') ne undef) {
|
|
$data{HOMELINK} .= '<a href="'.$cfg->get('home').'">[%Home%]</a> |';
|
|
}
|
|
if ($data{ERROR_MESSAGE} ne undef) {
|
|
$data{ERROR_BOX} =<<EOT;
|
|
<table width=$data{HTMLBASEWIDTH} cellpadding=0 cellspacing=0>
|
|
<tr>
|
|
<td align=center bgcolor="#CFDCE8">
|
|
<br>
|
|
<table width=500 cellpadding=0 cellspacing=0>
|
|
<tr>
|
|
<td class=error align=center>$data{ERROR_MESSAGE}</td>
|
|
</tr>
|
|
</table>
|
|
<br>
|
|
</td>
|
|
</tr>
|
|
</table>
|
|
EOT
|
|
}
|
|
my $template = loadtemplate();
|
|
$template =~ s/\(%\s*([a-zA-Z0-9_]+)\s*%\)/$data{$1}/g;
|
|
$template =~ s/\[%%\]//g;
|
|
$template =~ s/\[%([^]]+)%\]/TTXDictionary::translate($1)/ge;
|
|
print preparecookie()."\n$template";
|
|
#
|
|
# Update cache
|
|
#
|
|
if ($usecache) {
|
|
TTXCache::store($cfg, $query, $template, $pagesignature);
|
|
}
|
|
exit;
|
|
|
|
|
|
#================================================================== loadtemplate
|
|
|
|
sub loadtemplate {
|
|
my ($t, $style);
|
|
if ($query->param('cmd') eq 'newticket' && $query->param('form') ne undef) {
|
|
my @parts = split(/\/|\\/, $query->param('form'));
|
|
$t = pop @parts;
|
|
$t .= '.html';
|
|
# } elsif ($query->param('cmd') eq 'keyfinder') {
|
|
# $t = 'keyform.html';
|
|
}
|
|
if ($t eq undef) {
|
|
$t = $cmddef->{$query->param('cmd')}->{template};
|
|
$t = $query->param('cmd').".html" if $t eq undef;
|
|
}
|
|
my $fn = $cfg->get('basedir')."/templates";
|
|
if ($query->param('style') ne undef) {
|
|
my @parts = split(/\/|\\/, $query->param('style'));
|
|
$style = pop @parts;
|
|
}
|
|
if ($style ne undef) {
|
|
if ((! -f "$fn/$style/$t" || !open(TMPL, "$fn/$style/$t")) &&
|
|
(! -f "$fn/$t" || !open(TMPL, "$fn/$t"))) {
|
|
fatalerror("Missing template $t");
|
|
}
|
|
} elsif (! -f "$fn/$t" || !open(TMPL, "$fn/$t")) {
|
|
fatalerror("Missing template $t");
|
|
}
|
|
my @buff = <TMPL>;
|
|
close TMPL;
|
|
my $template = join('', @buff);
|
|
if (!($cmddef->{$query->param('cmd')}->{noheader} || $query->param('noheader'))) {
|
|
if (($style ne undef && open(TMPL, "$fn/$style/header.shtml")) || open(TMPL, "$fn/header.shtml")) {
|
|
my @hdr = <TMPL>;
|
|
close TMPL;
|
|
$template = join('', @hdr) . $template;
|
|
}
|
|
if (($style ne undef && open(TMPL, "$fn/$style/footer.shtml")) || open(TMPL, "$fn/footer.shtml")) {
|
|
my @ftr = <TMPL>;
|
|
close TMPL;
|
|
$template .= join('', @ftr);
|
|
}
|
|
}
|
|
return $template;
|
|
}
|
|
#======================================================================= command
|
|
|
|
sub command {
|
|
my $cmd = $_[0];
|
|
if (!defined $cmddef->{$cmd}) {
|
|
fatalerror("Unknown command [$cmd]");
|
|
}
|
|
if ($cmddef->{$cmd}->{access}) {
|
|
if ($cfg->get('_USER') eq undef) {
|
|
$cmd = 'login';
|
|
login('[%This command is available to operator only. Please login.%]');
|
|
}
|
|
}
|
|
my @action_path = split(/::/, $cmddef->{$cmd}->{action});
|
|
my $func = pop @action_path;
|
|
my $module = join("::", @action_path);
|
|
if ($module eq undef) {
|
|
fatalerror("No module defined for [$cmd] action");
|
|
}
|
|
if ($func eq undef) {
|
|
fatalerror("No function defined for [$cmd] action");
|
|
}
|
|
$module =~ /(.*)/; $module = $1;
|
|
eval "use $module";
|
|
fatalerror("Unable to load module $module<br><br>$@<br><br>SD:".scriptdir()) if $@;
|
|
my $markcmd = $cmd;
|
|
{
|
|
no strict 'refs';
|
|
$cmd = ($cmddef->{$cmd}->{action})->($cfg, $query, \%data);
|
|
}
|
|
fatalerror("Recursive call to $cmd") if $cmd eq $markcmd;
|
|
if ($cmd ne undef) {
|
|
$query->param(-name => 'cmd', -value => $cmd);
|
|
command($cmd);
|
|
}
|
|
return undef;
|
|
}
|
|
#========================================================================= login
|
|
|
|
sub login {
|
|
$query->param(-name => 'nextcmd', -value => $query->param('cmd'));
|
|
$query->param(-name => 'loginmsg', -value => $_[0]);
|
|
$query->param(-name => 'cmd', -value => 'login');
|
|
$query->param(-name => 'form', -value => '');
|
|
}
|
|
|
|
#==================================================================== fatalerror
|
|
|
|
sub fatalerror {
|
|
print <<EOT;
|
|
Content-type: text/html
|
|
|
|
<html>
|
|
<head><title>Trouble Ticket Express</title></head>
|
|
<body>
|
|
<br><center><h1>Fatal Error: $_[0]</h1>
|
|
</body>
|
|
</html>
|
|
EOT
|
|
exit;
|
|
}
|
|
# ==================================================================== scriptdir
|
|
|
|
sub scriptdir {
|
|
my $dir = $ENV{'SCRIPT_FILENAME'};
|
|
$dir = $ENV{'PATH_TRANSLATED'} if $ENV{'PATH_TRANSLATED'} ne undef;
|
|
$dir = $ENV{'pathTranslated'} if $ENV{'pathTranslated'} ne undef;
|
|
return $ENV{'PWD'} if $dir eq undef;
|
|
my @path = split(/\/|\\/, $dir);
|
|
pop(@path);
|
|
$dir = join("\/", @path);
|
|
return $dir;
|
|
}
|
|
# =================================================================== upgrademsg
|
|
|
|
sub upgrademsg {
|
|
print <<EOT;
|
|
<html>
|
|
<body>
|
|
<br><br>
|
|
<center>
|
|
The help desk system is temporary unavailable due to scheduled maintenance.
|
|
<br><br>
|
|
We will resume operations within next 5 minutes.
|
|
<br><br>
|
|
</center>
|
|
</body>
|
|
</html>
|
|
EOT
|
|
}
|
|
#=================================================================== readglobals
|
|
|
|
sub readglobals {
|
|
my @http_cookie = split(/; /,$ENV{'HTTP_COOKIE'});
|
|
my %cookies;
|
|
foreach (@http_cookie) {
|
|
my @parts = split('=',$_);
|
|
my $n = shift @parts;
|
|
my $v = join('=', @parts);
|
|
$cookies{$n}=$v;
|
|
}
|
|
my $cookiename = $cfg->get('cookiename');
|
|
if ($cookies{$cookiename} ne undef) {
|
|
$originalcookie = $cookies{$cookiename};
|
|
my @globals = split (/&/, $cookies{$cookiename});
|
|
foreach (@globals) {
|
|
my @parts = split('=',$_);
|
|
my $n = shift @parts;
|
|
my $v = join('=', @parts);
|
|
$v =~ s/%0D%0A/\n/g;
|
|
$v =~ s/%0A%0D/\n/g;
|
|
$v =~ tr/+/ /;
|
|
$v =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
|
|
$cfg->set("_GLOBAL_$n", $v);
|
|
}
|
|
}
|
|
}
|
|
#================================================================= preparecookie
|
|
|
|
sub preparecookie {
|
|
return undef if $cfg->get('_NOCOOKIE');
|
|
my $cookie;
|
|
foreach my $global (keys %{$cfg}) {
|
|
next if $global !~ /^_GLOBAL_/;
|
|
my $name = $global;
|
|
$name =~ s/^_GLOBAL_//;
|
|
my $value = $cfg->get($global);
|
|
next if $value eq undef;
|
|
$value =~ s/([^a-zA-Z0-9_])/sprintf("%%%X", ord($1))/eg;
|
|
$cookie .= '&' if $cookie ne undef;
|
|
$cookie .= "$name=$value";
|
|
}
|
|
return undef if $cookie eq $originalcookie;
|
|
return "Set-Cookie: ".$cfg->get('cookiename')."=$cookie; path=/; expires=Mon, 28-Dec-2037 00:00:00 GMT\n";
|
|
}
|
|
|
|
# end of file
|