home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / cgi-bin / discus / board-auth.cgi < prev    next >
Text File  |  2009-11-06  |  1KB  |  52 lines
  1. #!/usr/bin/perl
  2.  
  3. #
  4. #-------------------------------------------------------------------------------
  5. # DISCUS COPYRIGHT NOTICE
  6. #
  7. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  8. # The use of Discus is governed by the Discus License Agreement which is
  9. # available from the Discus WWW site at:
  10. #    http://www.discusware.com/discus/license
  11. #
  12. # Pursuant to the Discus License Agreement, this copyright notice may not be
  13. # removed or altered in any way.
  14. #-------------------------------------------------------------------------------
  15.  
  16. use strict;
  17. use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
  18.  
  19. $DCONF->{script_dir} = "/home/ftp/OS9/FAQ/cgi-bin/discus";
  20. my $e = get_cgi_extension($0);
  21.  
  22. if (-e "$DCONF->{script_dir}/config.$e") {
  23.     require "$DCONF->{script_dir}/config.$e";
  24. } elsif (-e "./config.$e") {
  25.     require "./config.$e";
  26. } else {
  27.     print "Content-type: text/html\n\n";
  28.     print "Script Execution Error: <b>config.*** location error [1]</b>.\n";
  29.     exit(0);
  30. }
  31. discus("board-auth");
  32.  
  33. sub get_cgi_extension {
  34.     my ($zero) = @_;
  35.     if ($zero =~ m|\.(\w+)$|) {
  36.         return $1;
  37.     }
  38.     foreach my $try ('cgi', 'pl') {
  39.         return $try if -e "./config.$try";
  40.     }
  41.     opendir(DIR, ".");
  42.     while (my $i = readdir(DIR)) {
  43.         return $1 if $i =~ m|^config\.(\w+)$|;
  44.     }
  45.     closedir(DIR);
  46.     print "Content-type: text/html\n\n";
  47.     print "Script Execution Error: <b>config.*** location error [2]</b>.\n";
  48.     exit(0);
  49. }
  50.  
  51. 1;
  52.