base

2026-08-07 17:38:18 +09:00
commit 873193a243
9613 changed files with 2755992 additions and 0 deletions
@@ -0,0 +1,123 @@
+#!/usr/bin/perl
+#
+# This script is a part of Trouble Ticket Express package
+# http://www.troubleticketexpress.com
+#
+# COPYRIGHT: 2002-2006, United Web Coders
+# http://www.unitedwebcoders.com
+#
+# $Revision: 274 $
+# $Date: 2006-09-20 00:03:43 +0400 (Wed, 20 Sep 2006) $
+#
+#
+# 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';
+
+# ==== NOTHING TO EDIT BELOW THIS LINE. PLS DO NOT CROSS IF NOT SURE ===========
+
+BEGIN {
+  my $sd = _findsd() || '.';
+  $sd =~ /(.*)/;
+  $sd = $1;
+  eval "use lib '$sd'";
+  if ($@) {
+    _fatalbegin($@);
+    exit 0;
+  }
+  if ($sd ne '.') {
+    chdir $sd;
+  }
+  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;
+    $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 TTXConfig;
+eval 'use GD';
+if ($@ ne undef) {
+  print <<EOT;
+Content-type: text/html
+
+<html>
+<body>
+Error loading GD.pm
+<br>
+$@
+</body>
+</html>
+EOT
+  exit 0;
+}
+#
+# Read config
+#
+my $configfile = "ttxcfg.cgi";
+my $cfg = TTXConfig->new($configfile);
+if ($cfg->error()) {
+  print "Content-type: text/html\n\n<html><body>Fatal error: ".$cfg->errortext()."</body></html>\n";
+  exit 0;
+}
+if ($cfg->get('cfgref') ne undef) {
+  if (!$cfg->load($cfg->get('cfgref'))) {
+    print "Content-type: text/html\n\n<html><body>Fatal error: ".$cfg->errortext()."</body></html>\n";
+    exit 0;
+  }
+}
+my $im = new GD::Image(50,20);
+my $white = $im->colorAllocate(255,255,255);
+my $black = $im->colorAllocate(0,0,0);
+$im->fill(0,0,$white);
+$im->rectangle(0,0,49,19,$black);
+my $keyfn = $ENV{QUERY_STRING};
+$keyfn =~ /([0-9-]+)$/;
+$keyfn = $1;
+if ($keyfn =~ /^\d+-\d+$/) {
+  if (open(KF, $cfg->get('basedir')."/keys/$keyfn.cgi")) {
+    my $key = <KF>;
+    close KF;
+    chomp $key;
+    $im->string(GD::gdGiantFont(), 6, 3, $key, $black);
+  }
+}
+print "Content-type: image/gif\nExpires: Wed, 13-Dec-1995 16:28:32 GMT\n\n";
+binmode STDOUT;
+print $im->gif();
+my $tm = time();
+$tm -= 24*3600;
+my $dir = $cfg->get('basedir').'/keys';
+if (opendir(KEYDIR, $dir)) {
+  my @files = grep { /^\d+-\d+\.cgi/ && -f "$dir/$_" } readdir(KEYDIR);
+  closedir KEYDIR;
+  foreach my $f (@files) {
+    $f =~ /^(\d+)/;
+    next if $1 > $tm;
+    unlink "$dir/$f";
+  }
+}
+