perl me ass, anybody help?

Enygma

Any chance of posting the code up here? 500's can be down to any number of things. Is the CGI outputting correct HTTP headers? Is it ouputting anything at all (make that mistake myself all the time )

Show me some code man!

---

My opinions may have changed, but not the fact that I am right.

satchmo

You might want to check if your LF/CRs are in the right place. I can't remember which combination you're meant to use, but i think it returns a 500 if you get it wrong.

Otherwise, make sure you're uploading the script using ASCII transfer mode, not binary. Binary'll also throw a 500 as far as I remember.

Lord Khan

#!/usr/bin/perl
#############################################################
# Player Registeratin v0.1
#############################################################
use CGI::Carp "fatalsToBrowser";          # Output errors to browser
use CGI qw(:standard);                    # Saves loads of work
$CGI::POST_MAX=1024 * 150;                # limit post data
$CGI:  [img]http://www.boards.ie/bulletin/biggrin.gif[/img]ISABLE_UPLOADS = 1;                # Disable uploads
$CGI::HEADERS_ONCE = 1;                   # Make sure we only have 1 header

eval {
($0 =~ m,(.*)/[^/]+,)   and unshift (@INC, "$1");
($0 =~ m,(.*)\\[^\\]+,) and unshift (@INC, "$1");
require "imail.lib";      # Require styles info
};
if ($@) {
    print header(); print start_html(-title=>"Error!");
    print "Could not find these files: $@\nIf you are running NT you may need to enter the full path in each require statement in each script";
    print end_html; exit;
}

$|++;                                    # Unbuffer the output

#################--- Begin the program ---###################

### VARIABLES ###

$adminemail_in = "drazicus@esatclear.ie";
$adminemail_out = "gamenet@esatclear.ie";

###   Following is a possibly the worst written code ever ... part 6.4234^4!

$thisprog = "register.cgi";

$query = new CGI;

&checkVALIDITY;

for ('inmembername','password','emailaddress') {
    next unless defined $_;
    next if $_ eq 'SEND_MAIL';
    $tp = $query->param($_);
    $tp = &unHTML("$tp");
    ${$_} = $tp;
    }

## This would be the header I think ]:-)
&title;

    $output .= qq~
    <p>
	<table width="58%" border="0" cellpadding="0" cellspacing="0">
 	<tr>
    		<td><img src="logo.gif" border=0></td>
    		<td align="right" valign="bottom">>> <a href="http://www.skynet.ie/%7Egamenet/index.htm">Back to Fragnet </a></td>
  	</tr>
 	</table>
    <p>
    <table cellpadding=0 cellspacing=0 border=0 width500 bgcolor=#999999 align=center>
    <tr><td>
    <table cellpadding=6 cellspacing=1 border=0 width=100%>
    ~;

if ($action eq "addmember") {

 #start add member
        $joineddate           = time;
        $ipaddress            = $ENV{'REMOTE_ADDR'};

## ok this is the part I want to try and make sure somebody doesn't reg 2 
## names with the same address
        # check against the email lists

        $filetoopen = "emaillist.cgi";

        open(FILE,"$filetoopen");
        @joinedmembers = <FILE>;
        close(FILE);
        

        foreach (@joinedmembers) {
            ($joinedemail) = split(/\|/,$_);
            chomp $joinedemail;
            if ($emailaddress =~ /^$joinededemail/) { $allowregister = "fail"; }
            }
        

        if ($joinedmember eq "yes") {
            print header(); &error("Registering&Sorry, the email address you have entered is already in use. Please email the administrator if any queries");
            }
    
 
### make sure its a valid form


    if($inmembername eq "") { $blankfields = "yes"; }
    if($password eq "")     { $blankfields = "yes"; }
    if($emailaddress eq "") { $blankfields = "yes"; }

    if ($blankfields) {
        print header(); &error("Registering&Please ensure that the username, emailaddress and password fields are filled in");
        }
    if($inmembername =~ /_/) { print header(); &error("Registering&Please do not use underscores in your name. You can enter a space if required"); }
    
    $inmembername =~ y/ /_/;
    
    $_ = $inmembername;
         if ((m/\b[_]/) || (m/\W+/) || (m/_{2,}/) || (m/[_]\b/)) {
             print header(); &error("Registering&Username contained invalid characters");
            }
    
    
    if($emailaddress !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { print header(); &error("Registering&Invalid Email Address"); }


    
### check for an already in use member name

        &getmember("$inmembername");
        if ($userregistered ne "no") { $allowregister = "fail"; }
        my ($tempinusername) = $inmembername;
        chomp $tempinusername;
        $filetocheck = "players/$tempinusername.cgi";
        if (-e $filetocheck) { $allowregister = "fail"; }
        $tempinusername =~ tr/a-z/A-Z/;
        $filetocheck = "players/$tempinusername.cgi";
        if (-e $filetocheck) { $allowregister = "fail"; }
        $tempinusername =~ tr/A-Z/a-z/;
        $filetocheck = "players/$tempinusername.cgi";
        if (-e $filetocheck) { $allowregister = "fail"; }
   
          
        $memberfiletitle = $inmembername;
        $memberfiletitle =~ y/ /_/;

        $filetomake = "$ikondir" . "player/$memberfiletitle.cgi";dd
        open(FILE, ">$filetomake");
        flock(FILE, 2);
        print FILE "$inmembername|$password|$emailaddress|$ipaddress|$joineddate|$misc1|$misc2|$misc3";
        close(FILE);
     
        $filetoopen = "$ikondir" . "players/emaillist.cgi";
        open(FILE,">>$filetoopen");
        print FILE "$inmember|$inemailaddress";
        close(FILE);


            $inmembername =~ y/_/ /;
            
            $output .= qq~
            <tr>
            <td bgcolor=$miscbacktwo valign=middle align=center><font face="$font" color=$fontcolormisc size=2><b>Thanks for registering $inmembername</b></font></td></tr>
            <tr>
            <td bgcolor=$miscbackone valign=middle><font face="$font" color=$fontcolormisc size=1>
            Status:
            <ul>
            <li><a href="$forumsummaryprog">Back to the forums index</a>
            </ul>
            </tr>
            </td>
            </table></td></tr></table>
            ~;
 
     
        
    
### Create a dummy file to foil snoopers, and to stop them gaining a list of the directory

    open (FILE, ">player/index.html");
    print FILE qq(
    <HTML><HEAD>
    <TITLE>401 Authorization Required</TITLE>
    </HEAD><BODY>
    <H1>Authorization Required</H1>
    This server could not verify that you
    are authorized to access the document
    requested.  Either you supplied the wrong
    credentials (e.g., bad password), or your
    browser doesn't understand how to supply
    the credentials required.<P>
    <HR>
    <ADDRESS>Apache/1.3.9 Server at $homeurl Port 80</ADDRESS>
    </BODY></HTML> );
    close (FILE);


### this I just though would be handy to keep track of the peons joining

    require "players/counter.cgi";
        
    $filetomake = "players/counter.cgi";
        
    $totalmembers++;
        
    open(FILE, ">$filetomake");
    flock(FILE, 2);
    print FILE "\$lastregisteredplayer = \"$inplayername\;\n";
    print FILE "\$totalmembers = \"$totalmembers\"\;\n";
    print FILE "\n1\;";
    close (FILE);

### Send the emails

             
                
                $to = "$emailaddress";
                $from = "fragnet <$adminemail_out>";
                $subject = "Thank You For Registering With FRAGNET Quake2 League";
                
                $message .= "\n";
                $message .= "Fragnet\n";
                $message .= "Quake 2 League\n\n\n";
                $message .= "Thank you for registering!\n\n\n";
                $message .= "Your username and password are below:\n\n";
                $message .= "   Username  : $inmembername\n";
                $message .= "   Password  : $password\n\n\n";
                $message .= "Usernames and passwords are case sensitive.\n\n";
                $message .= "Please note that you cannot change your password at any time\n";
                $message .= "in other words I was too lazy to put in this feature\n"; 
                $message .= "\n\n Thanks\n The Fragnet Crew\n";
                $message .= "\nwatch the fragnet page and forums for more details\n"; 
                &sendmail($from, $from, $to, $SMTP_SERVER, $subject, $message);
                
                } # end send password to member

                $to = "$adminemail_in";
                $from = "fragnet <$adminemail_out>";
                $subject = "New User Has Registered";

                $message = "";
                $message .= "\n";
                $message .= "Fragnet\n";
                $message .= "New Player Notification\n";
                $message .= "---------------------------------------------------------------------\n\n";
                $message .= "New user registration information:\n\n";
                $message .= "   Username  : $inmembername\n";
                $message .= "   Email     : $emailaddress\n";
                $message .= "   IP Address: $ipaddress\n\n";
                $message .= "---------------------------------------------------------------------\n";
               
                &sendmail($from, $from, $to, $SMTP_SERVER, $subject, $message);
                
                } # end routine


} # end routine

### Print the form


$output .= qq~

<form action="$thisprog" method=post name="creator">
<tr>
    <td bgcolor=$miscbacktwo><b>Name:</b><br>
      cannot be more than 20 characters in length</td>
<td bgcolor=$miscbacktwo><input type=text size=20 maxlength="20" name="inmembername">
    </td>
  </tr>
        <tr>
        
    </tr><p>*</p><tr><td bgcolor=$miscbackone><br><b>Password:</b><br>
      Please choose a password, all passwords are case sensitive.<br>Please do not use any 'wild' characters such as '*' '|' or any other HTML characters</td>
        <td bgcolor=$miscbackone><input type=text size=20 name="password"></td>
        </tr>
  <tr><br>
    <td bgcolor=$miscbackone>
      <p>*</p>
      <p><b>Email Address:</b><br>
        Please enter a valid email address, this will be used to keep track of 
        games.</p>
    </td>
    <td bgcolor=$miscbackone>
      <input type=text size=20 name="emailaddress">
    </td>
    <br>
  </tr>
  <tr>
    <td bgcolor=$miscbackone>*</td>
  </tr>
  <tr>
    <td bgcolor=$miscbackone>*</td>
  </tr>
  <tr>
<td colspan=2 bgcolor=$miscbacktwo align=center><input type=submit value=submit name=submit></td>
<input type=hidden name=action value=addmember></form></tr></table></td></tr></table>

~;

} # end agree


else { # show register agree form

    
    $filetoopen = "players/register.dat";

    open(FILE,$filetoopen) or die "Cannot locate the register.dat file, this should be in the data directory";
    @filedata = <FILE>; close(FILE);
    foreach (@filedata) { $tempoutput .= $_; }
    
    $output .= qq~
    <form action="$thisprog" method="post">
    <input name="action" type="hidden" value="agreed">
    <tr>
    <td bgcolor=$miscbacktwo align=center><font face="$font" color=$fontcolormisc size=3>
    <b>Terms and conditions of service</b>
    </td>
    </tr>
    <td bgcolor=$miscbackone align=left><font face="$font" color=$fontcolormisc size=2>

     $tempoutput
        
    </td>
    </tr>
    <tr>
    <td bgcolor=$miscbacktwo align=center>
    <center><input type="submit" value="I Agree"></center>
    </td></tr></table>
    </form>
    </td></tr></table>
    ~;


} # end elseform

    print header(-cookie=>[$namecookie, $passcookie]);    
    
    &output(
    -Title   => "Fragnet Quake2 League", 
    -ToPrint => $output, 
    -Version => $versionnumber 
    );

I didn't up it since I've direct access to the server anyway....


the code is messy I admit but I'm a novice at perl really. mail.lib is just a template for sending mail

[This message has been edited by Lord Khan (edited 20-03-2001).]

satchmo

The first line output to the browser has to be a HTTP header, and there has to be a blank line after the header data.

Put

print "Content-type: text/html \n\n";

at the start of your header.

Enygma

The HTTP headers are fine since he's using CGI.pm the header() sub handles all that.

I've only had a small bit of time to go through the code right now, (I'm in wrk ) but from what I can see you keep appending to $output but never actually print it out.
Unless you've defined &output somewhere else, I dunno what that does??
I'll get a better chance to look at it later.

By the way, where is it getting $action from? I presume it's coming in on the request but it's never actually defined in the script.

Try running it from the command line if you can.

e.g.
$ ./script.cgi

name=name
email=email
etc.
^Z (^D?)

That should give you a better idea of whats wrong with it.

satchmo

You're going to need to escape the @s in your email addresses, ie

$adminemail_in = "drazicus\@esatclear.ie";
$adminemail_out = "gamenet\@esatclear.ie";

cause otherwise it thinks esatclear is an array.

I think you've some curly bracket problems too.

Lord Khan

well in theory the script should be calling it self :-)

I've done it before but just on a lot small scale ...

yeah knew I missed those \ in the address I'm always missing those :-)

I've double checked those Curlies time and time again I should have matchin sets the whole way through afaik... ok I think I need to redefine a few things in the code I had another file but don't seem to have added in the bits from that.

Lord Khan

Trying to write a perl cgi that would allow users to register name,pass,email address and store them to a text file in that order and have emails stored to another file also.

but my prog just 500's out on me(chmod is correct)

basically I'm trying to setit so that player would report on duels ... IE loser reports both loser and winner get email confirming that.

and it would keep a score board. I've screwed up completely on this and just wondering anybody have any old perl scripts that might help me with this? Podgeen was suppose to do it, but lets not over burden the poor boy hez in third year and all :-)

Lord Khan

well I reworked the code and got most of it working Most of it


think I forgot a few things ... like cookies :-)

[This message has been edited by Lord Khan (edited 22-03-2001).]