[Perl] Geheugen loopt vol

[Verwijderd]

Allo Mensen,

Ik zit met een probleempje:

Ik ben een control panel aan het coden in perl! Maar daar hoort ook een eigen webserver bij (die heb ik dus ook in perl geschreven)! Werkt allemaal prima,

Behalve dan dat het geheugen vol loopt (Elke keer 1 pagina bekijken vergt 35 MB van het geheugen)

Ik heb het hele script na gezocht, maar ik kan er maar niet uitkomen!

Is er een debug mogelijkheid om je script door te lopen, met het geheugen gebruik?
Of zijn er nog andere mogelijkheden?

Iemand tips?


Hartelijk dank

Groeten Ruben

[NMe]

Heb je de normale dingen gedaan die je moet doen bij overmatig geheugengebruik? Maak je bijvoorbeeld objecten aan die je niet meer opruimt?

[Juup]

Post (een deel van) je code.
Gebruik je strict en warnings?
Waarom gebruik je je eigen webserver en geen apache ofzo?

[Verwijderd]

Ik gebruik inderdaat strict en warnings!

Hier de code van de http_handler:

code:

sub http_request_handler {

use Switch;

    my $fh     =   shift;
    my $req_   =   shift;
    my %req    =   %$req_;

    my %header = %{$req{HEADER}};
    my $lines;
    my $tmpnum;

    #print $fh "Method: $req{METHOD}<br>";
    #print $fh "Object: $req{OBJECT}<br>";

    my $bdir   = "/xost-panel";
    
    my $auth_required;
        
    my @url = split(/\?/,$req{OBJECT});
    my $object = $url[0];
    my @variable = split(/&/,$url[1]);
    
    #print "Er is een request naar: " . $object . "\r\n";
        
    my $host    = $header{"host"};
    my @portstring  = split(/:/,$host); 
        
    my $auth_message;

    if ( $portstring[1] == "5000" )
    {
        $auth_message   = "Xost-Panel \"X-Admin\"";
    }
    else
    {
        $auth_message   = "Xost-Panel \"X-User\"";
    }       
        

    my  $authheader;    

    $authheader = $header{"authorization"};
        $authheader =~ s/Basic //g;



        use MIME::Base64;
        my $authstring = decode_base64($authheader);
        my @splitauth  = split(/:/,$authstring);

        $auth_username = $splitauth[0];


    if ( $auth_username eq "" )
        {
             
     #print "On ingelogde gebruiker\r\n";
        
     print $fh "HTTP/1.1 401 Unauthorized\r\n";
     print $fh "WWW-Authenticate: Basic realm=\"$auth_message\"\r\n";
     print $fh "HTTP/1.1 401 Unauthorized\r\n";
     print $fh "Content-type: text/html\r\n";
         print $fh "X-Powered-By: Xost/1.0\r\n";
         print $fh "\r\n";
         print $fh &auth_required;


        
    }
    else
    {
        #print "Er is een password opgegeven!\n\r";

        $authheader = $header{"authorization"};
            $authheader =~ s/Basic //g;
    
        
                use MIME::Base64;
                $authstring = decode_base64($authheader);

                @splitauth  = split(/:/,$authstring);
    
                my $auth_username = $splitauth[0];
                my $auth_password = $splitauth[1];
        
        #print "Probeert In te loggen met U: " . $auth_username . " | W: " .  $auth_password . "\r\n";
    
        use Digest::MD5;
        
        
        my $md5 = Digest::MD5->new;
        $md5->add($auth_password);
        $digest = $md5->hexdigest;
        
        my $pass_hash = $digest . "n" ;
        
        if( -e "/etc/xost-panel/data/shadow/$auth_username.pwd" )
        {
        
            #print "Gebruikersnaam is juist!\r\n";
            $match_hash = `cat /etc/xost-panel/data/shadow/$auth_username.pwd`;
            

            #print $fh $match_hash . "\r\n";

            if ( $match_hash == $pass_hash )
            {
                #print "Wachtwoord is juist! Gebruiker mag naar binnen!\r\n";
                $XOST_AUTH_LOGIN = $match_hash;
                $OK = 1;

                $match_hash = "";
            }
            else
            {
                
                #print "Gebruikersnaam en Wachtwoord Combinatie is onjuist!\r\n";

                print $fh "HTTP/1.1 401 Authorization Required\r\n";
                print $fh "WWW-Authenticate: Basic realm=\"$auth_message\"\r\n";
                print $fh "HTTP/1.1 401 Unauthorized\r\n";
                print $fh "Content-type: text/html\r\n";
                        print $fh "X-Powered-By: Xost/1.0\r\n";
                        print $fh "\r\n";
                        print $fh &auth_required;
                $match_hash = "";

            }
            
            

        }
        else
        {
            #print "Gebruikersnaam is onjuist! \r\n";           

            print $fh "HTTP/1.1 401 Authorization Required\r\n";    
            print $fh "WWW-Authenticate: Basic realm=\"$auth_message\"\r\n";
            print $fh "HTTP/1.1 401 Unauthorized\r\n";
                        print $fh "Content-type: text/html\r\n";
                        print $fh "X-Powered-By: Xost/1.0\r\n";
                        print $fh "\r\n";
            print $fh &auth_required;
            
            

        }
    

    }   

    if( $OK eq "1" )
    {

        #print "HTTP/1.1 200 OK\r\n";
        print $fh "HTTP/1.1 200 OK\r\n";
    }
    
    if($XOST_AUTH_LOGIN ne "")
    {
        
        #print "test\r\n";
        


        if($object eq "/" ) 
        {

            my $openfile = "/xost-panel/main.pl";

            my $tmpnum   = &generate_random_string(7);
            $content = `perl $openfile`;
             

        }
        else 
        {
    
             $openfile = $bdir . $object;
        
        

            if ( -e $openfile ) 
            {

                
                my @splitter = split(/\./,$object);
                my $i = 1;          
            
                                                
                

                 
            
                my $extensie = $splitter[$i];
            
                #print "test";
            

                if ( $extensie eq "pl" || $extensie eq "cgi" ) 
                {
                        
                    #print "test";                  
                    $tmpnum     = &generate_random_string(7);
                        
                    my $newfile     =  "/tmp/tmpoutput$tmpnum.pld";
                    $do         = `touch $newfile`;

                    open(OUT,">>$newfile") || print "An error occurred!";
                    print   (OUT "#!/usr/bin/perl\r\n");
                    
                                    
                    
                    $o = 0;

                    my $get_variable;
                    my $get_key;
                    my $get_value;

                    while ( $variable[$o] ne "")
                    {
                        
                        @get_variable   = split(/=/,$variable[$o]);
                        $get_key    = $get_variable[0];
                        $get_value  = $get_variable[1];             
                        
                                            
                    
                        print   (OUT '$GET_VAR{"' .  $get_key . '"} = "' . $get_value . '";' . "\r\n");  
                                        
                        $o++;
                    }

                    $get_variable = "";
                    $get_key = "";
                    $get_value = "";
                    
                    #$host =~ s/\n//g;
        
                    print   (OUT '$SERVER{REQUEST_HOSTNAME}         = "' . $host . '";' . "\r\n");
                    print   (OUT '$XOST_USER                = "' . $auth_username . '";' . "\r\n");
                    print   (OUT 'require ("' . $openfile . '");' . "\r\n");
                    
                    close (OUT); 
                    
                    $do = `chmod +x $newfile`;
                     
                    
                    print $fh "Content-type: text/html\r\n";
                            print $fh "X-Powered-By: Xost/1.0\r\n";

                    print $fh "\r\n";

                    $content = `perl $newfile`;
                    print $fh $content;
                        #print $newfile;

                    #$do  = `rm $newfile -rf`;
                    
                }
                else 
                {   
                    
                    print "test";
                    switch ($extensie)
                    {
                        case "jpg"
                        {
                            print $fh "Content-type: image/jpeg\r\n";
                        }
                        case "gif"
                        {
                            print $fh "Content-type: image/gif\r\n";

                        }
                        case "png"
                        {
                            print $fh "Content-type: image/png\r\n";
                        }
                        
                    }
                    
                    print $fh "\r\n";

                    print $fh `cat $openfile`;
                    
                    

                }   
            }
        }
    }

#print "\r\n\r\n\r\n";
$do = "";
$content = "";
}

 sub init_webserver_extension {
    $port_listen = 5000;
}

        
sub auth_required
{
            
    my $message = "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
    <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>
    <P>Additionally, a 404 Not Found
    error was encountered while trying to use an ErrorDocument to handle the request.
    <HR>
    <ADDRESS>Xost Server/1.0 Server</ADDRESS>
    </BODY></HTML>";
    
    return $message;

    

}

sub generate_random_string
{
    my $length_of_randomstring=shift;# the length of 
             # the random string to generate

    my @chars=('0','1','2','3','4','5','6','7','8','9');
    my $random_string;
    foreach (1..$length_of_randomstring) 
    {
        # rand @chars will generate a random 
        # number between 0 and scalar @chars
        $random_string.=$chars[rand @chars];
    }
    return $random_string;
}

1;

Ik ben niet zo'n held in perl!

[ Voor 25% gewijzigd door Verwijderd op 12-11-2004 14:31 ]

[Verwijderd]

Hier de code van de webserver zelf:

code:

#!/usr/bin/perl
use strict;
use warnings;

use Socket;
use IO::Select;

use threads;
use threads::shared;


$|  = 1;

# The following variables should be set within init_webserver_extension
use vars qw/
 $port_listen
/;


require "/etc/xost-panel/include/http_handler.pl";
init_webserver_extension();

local *S;

socket     (S, PF_INET   , SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!";
setsockopt (S, SOL_SOCKET, SO_REUSEADDR, 1);
bind       (S, sockaddr_in($port_listen, INADDR_ANY));
listen     (S, 5)                                               or die "don't hear anything:  $!";

my $ss = IO::Select->new();
$ss -> add (*S);


while(1) {
    my @connections_pending = $ss->can_read();
    foreach (@connections_pending) {
        my $fh;
        my $remote = accept($fh, $_);

        my($port,$iaddr) = sockaddr_in($remote);
        my $peeraddress = inet_ntoa($iaddr);

    my $t = threads->create(\&new_connection, $fh);
    }
}

sub extract_vars {
  my $line = shift;
  my %vars;

  foreach my $part (split '&', $line) {
    $part =~ /^(.*)=(.*)$/;

    my $n = $1;
    my $v = $2;
  
    $n =~ s/%(..)/chr(hex($1))/eg;
    $v =~ s/%(..)/chr(hex($1))/eg;
    $vars{$n}=$v;
  }

  return \%vars;
}

sub new_connection {
  my $fh = shift;

  binmode $fh;

  my %req;

  $req{HEADER}={}; 

  my $request_line = <$fh>;
  my $first_line = "";

  while ($request_line ne "\r\n") {
     unless ($request_line) {
       close $fh; 
     }

     chomp $request_line;

     unless ($first_line) {
       $first_line = $request_line;

      my @parts = split(" ", $first_line);
       if (@parts != 3) {
         close $fh;
       }

       $req{METHOD} = $parts[0];
       $req{OBJECT} = $parts[1];
     }
     else {
       my ($name, $value) = split(": ", $request_line);
       $name       = lc $name;
       $req{HEADER}{$name} = $value;
     }

     $request_line = <$fh>;
  }

  http_request_handler($fh, \%req);
  close $fh;

  $fh = "";
  $request_line = "";
  $first_line = "";

}

[muba]

Ik weet er weinig van, maar wordt alles wel netjes afgesloten nadat de pagina is verzonden?

En waarom gebruik je, zoals reeds geopperd, niet een bestaande webserver?

Apache
Een hele bekende, waar veel voor/over is geschreven. Heb er zelf niet veel ervaring mee.
http://www.apache.org

Xitami
Een simpele, makkelijke, lichtgewicht webserver die je onwijs kan configgen, tweaken en fine tunen. Maar het hoeft niet: gewoon installeren en hij werkt. Ik gebruik hem al jaren.
http://www.imatix.com (check voor de Xitami webserver)

[ Voor 5% gewijzigd door muba op 11-11-2004 12:47 ]

[Verwijderd]

Nou ik maak gebruik van 2 webservers!

Apache, waar alle hosting klanten op komen te staan.
En een eigen alleen voor het control panel.

Waarom geen bestaande?

- Je zit met beveiliging!

Op een apache server kan ik moeilijk mijn server rebooten.
Anders gaat elke gek dat doen als ie daar zin in heeft!

- het control panel staat op een andere poort.

Ik weet niet of ik met 1 apache server op 2 verschillende poorten kan uitzenden!

En zijn nog wel meer redenen!

[Creepy]

Verwijderd schreef op 11 november 2004 @ 13:26:
Nou ik maak gebruik van 2 webservers!

Apache, waar alle hosting klanten op komen te staan.
En een eigen alleen voor het control panel.

Waarom geen bestaande?

- Je zit met beveiliging!

Op een apache server kan ik moeilijk mijn server rebooten.
Anders gaat elke gek dat doen als ie daar zin in heeft!

Ik weet nu al bijna zeker dat apache beter beveiligd is dan jouw zelf geschreven webserver. (zeker als je niet echt een perl kenner bent).
.htaccess voor toegang en een https verbinding lijkt me veilig zat zo op het eerste gezicht. Eventueel kan je nog een perl cgi username/passwd combo's uit een DB laten ophalen.

- het control panel staat op een andere poort.

Ik weet niet of ik met 1 apache server op 2 verschillende poorten kan uitzenden!

En zijn nog wel meer redenen!

Apache kan prima op meerdere poorten draaien, en op een andere poort een geheel andere site laten draaien is ook geen probleem.

Dus tot zover ik zie zijn er geen redenen om niet gebruik te maken van een bestaande webserver, tenzij je puur voor jezelf aan het leren bent hoe een webserver in Perl te schrijven.

[JaWi]

Om maar met de woorden van Randal Schwartz te praten: "stop met het opnieuw uitvinden van het wiel en jezelf (onnodig) veel werk op je hals te halen". Er zijn immers genoeg modules geschreven in Perl welke precies doen wat jij wil: een webserver maken.

Daarnaast lijkt het mij -als beveiliging toch een issue is- vele malen handiger om een ``bewezen'' webserver als Apache/IIS/... te gebruiken, aangezien de meeste security-issues al uitgestreken zijn. Daarnaast kun je Apache op meerdere poorten laten luisteren, als je niet wil dat je klanten bij je control-panel kunnen...

edit:

Creepy was net ietsjes sneller, two minds: one thought...

[ Voor 8% gewijzigd door JaWi op 11-11-2004 14:00 ]

[Creepy]

JaWi schreef op 11 november 2004 @ 13:59:
Om maar met de woorden van Randal Schwartz te praten: "stop met het opnieuw uitvinden van het wiel en jezelf (onnodig) veel werk op je hals te halen". Er zijn immers genoeg modules geschreven in Perl welke precies doen wat jij wil: een webserver maken.

edit:

Creepy was net ietsjes sneller, two minds: one thought...

Wat Randal Schwartz vergeet is dat je van "opnieuw het wiel uitvinden" wel een hoop kunt leren. Maar als je een webserver gaat schrijven omdat je niet weet hoe je apache moet configureren dan ben je verkeerd bezig ja

[Verwijderd]

Sorry dat ik er niet mee eens ben!

De meeste CP's hebben hun eigen webserver! Cpanel, Plesk en Webmin noe het maar op! hebben ook allemaal een eigen webserver!

Het zijn maar een paar functies die ze hebben en dan valt er ook niks te hacken. Het is niet zo geavanceerd als apache! htacces etc..


Het voordeel hiervan is dat als apache uit donderd. De hoster of systeembeheerder, eerst het probleem moet vinden voor dat ie weer in het Control panel kan!

Ik heb hier al zolang over na gedacht, en ik kan apache moeilijk root rechten geven om services te laten herstarten! Zodat elke gebruiker die een beetje verstand van coden heeft de heleboel laat crashen. system("rm *"); of <?php shell_exec() ?>

Ik heb zelf nog gedacht aan cronjobs, maar dan heb ik ook een helebooel dingen die niet kunnen!

Er zijn gewoon veel te veel nadelen!

Het klopt ook dat ik nog niet zo goed in perl ben, maar wel heel goed in php, vb, bash en asp. Dus kan ik dit toch ook leren?

[ Voor 6% gewijzigd door Verwijderd op 11-11-2004 14:17 ]

[zeroxcool]

Verwijderd schreef op 11 november 2004 @ 14:16:
Sorry dat ik er niet mee eens ben!

De meeste CP's hebben hun eigen webserver! Cpanel, Plesk en Webmin noe het maar op! hebben ook allemaal een eigen webserver!

Ik heb zelf nog gedacht aan cronjobs, maar dan heb ik ook een helebooel dingen die niet kunnen!

Die gebruiken bijna allemaal gewoon Apache op Webmin na. En wat kunnen cronjobs niet?

[Verwijderd]

Cpanel en Plesk gebruiken geen apache! Ben ik zeker van.


En ik vind het ook zonde om mijn webservertje aan de kant te mieteren! K'heb er al zoveel tijd in gestopt! ik moet gewoon dat lekje er uithebben!

[ Voor 5% gewijzigd door Verwijderd op 11-11-2004 14:25 ]

[JaWi]

Als je dan per se dat lekje eruit wil hebben, dan vermoed ik dat het zit in het gebruik van 'threads'; dit is een wat ``minder prettige'' (als in: traag en nogal geheugen-intensief) functionaliteit die Perl bezit. Je zou dit kunnen omzeilen door het gebruik van het forks. Zie o.a. de perlipc pagina voor meer info over hoe je dit op een veilige manier kan doen.

[JaWi]

Creepy schreef op 11 november 2004 @ 14:15:
[...]
Wat Randal Schwartz vergeet is dat je van "opnieuw het wiel uitvinden" wel een hoop kunt leren. Maar als je een webserver gaat schrijven omdat je niet weet hoe je apache moet configureren dan ben je verkeerd bezig ja

*grin* Ik begrijp wat je bedoeld, echter is het credo van Randal simpelweg: ``use the source Luke, use the source''... Tja, dan ben je snel uitgepraat

[Juup]

Als ik zo naar je code kijk dan kan ik n iet geloven dat JIJ dit geschreven hebt en dat jij niet weet hoe je een memory leak moet zoeken. Biecht maar op...

[Verwijderd]

Juup schreef op 11 november 2004 @ 23:34:
Als ik zo naar je code kijk dan kan ik n iet geloven dat JIJ dit geschreven hebt en dat jij niet weet hoe je een memory leak moet zoeken. Biecht maar op...

Nee, ik heb niet alles geschreven! Ik heb alleen de http handler geschreven.
Het begin scriptje is te downloaden op:

http://www.google.nl/sear...mple+perl+webserver&hl=nl

Dus wel het meeste code!

Ik heb veel programmeer kennis, maar niet in perl! Maar wel genoeg om een http handler te schrijven!

[ Voor 10% gewijzigd door Verwijderd op 12-11-2004 14:35 ]

[muba]

Jeetje, voel je eens niet zo opgefokt man. Met al die uitroeptekens overal

Heb je al geprobeerd - zoals aangeraden - fork te gebruiken ipv threads?

[dusty]

debuggen? dat staat heel netjes uitgelegd in de FAQ.

Als je dat had doorgelezen had je ondertussen zelf al een manier moeten weten om te zoeken waar het geheugen lek vandaan komt.