fs_webdemo/register.cgi

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: register.cgi,v 1.5 2000-03-03 18:22:42 ivan Exp $
   4
   5 use strict;
   6 use vars qw(
   7              $datasrc $user $pass $x
   8              $cgi $username $email
   9              $dbh $sth
  10              );
  11              #$freeside_bin $freeside_test $freeside_conf
  12              #@pw_set @saltset
  13              #$user_pw $crypt_pw
  14              #$header $msg
  15 use CGI;
  16 use CGI::Carp qw(fatalsToBrowser);
  17 use DBI;
  18 #use Mail::Internet;
  19 #use Mail::Header;
  20 #use Date::Format;
  21
  22 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  23 $ENV{'SHELL'} = '/bin/sh';
  24 $ENV{'IFS'} = " \t\n";
  25 $ENV{'CDPATH'} = '';
  26 $ENV{'ENV'} = '';
  27 $ENV{'BASH_ENV'} = '';
  28
  29 #$freeside_bin = '/home/freeside/bin/';
  30 #$freeside_test = '/home/freeside/test/';
  31 #$freeside_conf = '/usr/local/etc/freeside/';
  32
  33 $datasrc = 'DBI:mysql:http_auth';
  34 $user = "freeside";
  35 $pass = "maelcolm";
  36
  37 ##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
  38 ##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' );
  39 #@pw_set = ( 'a'..'z', '0'..'9' );
  40 #@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  41
  42 ###
  43
  44 $cgi = new CGI;
  45
  46 $username = $cgi->param('username');
  47 $username =~ /^\s*([a-z][\w]{0,15})\s*$/i
  48   or &idiot("Illegal username.  Please use 1-16 alphanumeric characters, and start your username with a letter.");
  49 $username = lc($1);
  50
  51 $email = $cgi->param('email');
  52 $email =~ /^([\w\-\.\+]+\@[\w\-\.]+)$/
  53   or &idiot("Illegal email address.");
  54 $email = $1;
  55
  56 ###
  57
  58 #$user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
  59 #$crypt_pw = crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]);
  60
  61 ###
  62
  63   local $SIG{HUP} = 'IGNORE';
  64   local $SIG{INT} = 'IGNORE';
  65   local $SIG{QUIT} = 'IGNORE';
  66   local $SIG{TERM} = 'IGNORE';
  67   local $SIG{TSTP} = 'IGNORE';
  68   local $SIG{PIPE} = 'IGNORE';
  69
  70 ###
  71
  72 $dbh = DBI->connect( $datasrc, $user, $pass, {
  73         'AutoCommit' => 'true',
  74 } ) or die "DBI->connect error: $DBI::errstr\n";
  75 $x = $DBI::errstr; #silly; to avoid "used only once" warning
  76
  77 $sth = $dbh->prepare("INSERT INTO mysql_auth VALUES (". join(", ",
  78   $dbh->quote($username),
  79 #  $dbh->quote("X"),
  80 #  $dbh->quote($crypt_pw),
  81   $dbh->quote($email),
  82   $dbh->quote('freeside'),
  83   $dbh->quote('unconfigured'),
  84 ). ")" );
  85
  86 $sth->execute or &idiot("Username in use: ". $sth->errstr);
  87
  88 $dbh->disconnect or die $dbh->errstr;
  89
  90 ###
  91
  92 $|=1;
  93 print $cgi->header;
  94 print <<END;
  95 <HTML>
  96   <HEAD>
  97     <TITLE>Freeside demo registration successful</TITLE>
  98   </HEAD>
  99   <BODY BGCOLOR="#FFFFFF">
 100   <table>
 101     <tr><td>
 102     <p align=center>
 103       <img border=0 alt="Silicon Interactive Software Design" src="http://www.sisd.com/freeside/small-logo.gif">
 104     </td><td>
 105     <center><font color="#ff0000" size=7>freeside demo registration successful</font></center>
 106     </td></tr>
 107   </table>
 108   <P>Your sample database has been setup.  Your password and the URL for the
 109     Freeside demo have been emailed to you.
 110   </BODY>
 111 </HTML>
 112 END
 113
 114 ###
 115
 116 sub idiot {
 117   my($error)=@_;
 118   print $cgi->header, <<END;
 119 <HTML>
 120   <HEAD>
 121     <TITLE>Registration error</TITLE>
 122   </HEAD>
 123   <BODY BGCOLOR="#FFFFFF">
 124     <CENTER>
 125     <H4>Registration error</H4>
 126     </CENTER>
 127     <P><B>$error</B>
 128     <P>Hit the <I>Back</I> button in your web browser, correct this mistake,
 129        and submit the form again.
 130   </BODY>
 131 </HTML>
 132 END
 133
 134   exit;
 135
 136 }