VPF::Premature end of script headers - Форум программистов

Acraft

Дата 14.4.2006, 15:22 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 69
Регистрация: 19.4.2005

Репутация: нет
Всего: 2

Что-то с заголовками. Раньше прекрасно работало, а теперь "Premature end of script headers: script_name.pl" (апач - [error] [client IP] Premature end of script headers: script_name.pl)

- права 755
пробовал играться с кодировками,
(print "Content-type:text/html\n\n";
Content-Type: text/html; charset=ISO-8859-1 )
не помогает.

Код


#!/usr/bin/perl

use GD;
use CGI::Cookie;
use Digest::MD5;
use imageconf;

$image_files = "itemplates";
$login = "$image_files/login.htm";
$index = "$image_files/index.htm";
$resize = "$image_files/resize.htm";
$resizecontinue = "$image_files/resizecontinue.htm";
$transfer = "$image_files/transfer.htm";

$CONVERT_LIMIT = 300;

&main;

sub err {
  print $_[0];
  exit(0);
}


sub loadtemplate {
    my $myfile = $_[0];
    open (FILE, "$myfile") or &err("Error: $myfile file not opened");
    while(<FILE>) {
        while (/\$value\((.*?)\)/) {
            my $inside = $1;
            $inside =~ s/[\n\t\s\"\']//g;
            if ($inside =~/,/) {
                 my @funcs = split(/,/,$inside);

                 if ($FORM{$funcs[0]} eq $funcs[1]) {
                   s/\$value\((.*?)\)/value="$funcs[1]" $funcs[2]/;
                 }
                 else {
                   s/\$value\((.*?)\)/value="$funcs[1]"/;
                 }
            }
            else {
                s/\$value\((.*?)\)/name="$inside" value="$FORM{$inside}"/;
        }
        }


        my $backup = $_;
        s/\$([qwertyuiopasdfghjklzxcvbnm]\w*)/&html_secure($FORM{$1},$1)/gies;
    $html .= $_;

        $backup =~ s/\$([qwertyuiopasdfghjklzxcvbnm]\w*)/&html_secure($FORM{$1},$1)/gies;
    $text .=$backup;
    }
    close(FILE);
}

sub html_secure {
   if (($_[1] ne "zipfilesoptions") && ($_[1] ne "goon")){
       $_[0] =~s/</&lt;/g;
       $_[0] =~s/>/&gt;/g;
   }
   return $_[0];
}

sub outputhtml {
  print $html;
  exit(0);
}


sub getpassword {
    my ($password_file) = @_;

    if (!open (FILE, $password_file)) {
        print "Content-type: text/html\n\n";
        &err("Error: $myfile file not opened");
    }

    my $content = "";
    while(<FILE>) {
        $content .= $_;
    }
    close(FILE);
    $content =~ s/[\r\n]//gi;
    return $content;
}

sub login {
    print "Content-type: text/html\n\n";
    loadtemplate($login);
    outputhtml();
}

sub loginpost {

    $content = getpassword($password_file);

    if ($content ne $FORM{upass}) {
        $FORM{error} = "Error: Wrong password!";
        login();
    }

        my $ctx = Digest::MD5->new; $ctx->add($password);
        my $digest = $ctx->hexdigest;

    my $c = new CGI::Cookie(-name    =>  'image_md5_hash',
                             -value   =>  $digest,
    );

    print "Set-Cookie: $c\n";
    print "Content-type: text/html\n\n";

    index2();
}

sub untarfiles {
    system("$tar -C $tmp_dir -xf $zip_dir".$FORM{zipname}." ");
    index3();
}

sub unzipfiles {

    system("$unzip -P $unzippass -qo $zip_dir".$FORM{zipname}." -d $tmp_dir");
    opendir(DIR, $tmp_dir);
    my $flag;

    do {
        $flag = 0;
    
        @files = readdir(DIR);
        close(DIR);
        foreach (@files) {
            my $fname = $_;
            if ((-f $tmp_dir.$fname) && ($fname =~ /\.zip$/i)){
                system("$unzip -P $unzippass -qo $tmp_dir".$fname." -d $tmp_dir");
                unlink($tmp_dir.$fname);
                $flag = 1;
            }
        }
    }
    while($flag);


    index3();
}


sub resizefiles {

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


    $FORM{indir} = "$tmp_dir";
    $FORM{outdir} = "$tmp_dir2";

    loadtemplate($resize);
    outputhtml();
}

sub renamefiles {

    $FORM{goon} = "";
    $FORM{nrename} = 0;
    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir.$fname) && (($fname =~ /\.jpg$/i) || ($fname =~ /\.jpeg$/i))) { 
            if ($fname =~ /^(.*?)_(.).*/) {
                
                my $l = $2;
                $l = ord(uc($l));
                if (($l >= ord('1')) && ($l <= ord('9'))) {
                    $l = chr($l + ord('a') - ord('1'));
                }
                else {
                    if (($l >= ord('A')) && ($l <= ord('Z'))) {
                        $l = chr($l + ord('j') - ord('A'));
                    }
                }
                my $newfname = $1.$l.".jpg";
                if ($newfname ne "" ) {                
                    rename($tmp_dir.$fname, $tmp_dir.$newfname);
                }
                $FORM{nrename}++;

            }
        }
    }
    $FORM{goon} = "<BR><STRONG>".$FORM{nrename}." files renamed. <A HREF=\"".$FORM{script}."?action=resizefiles\">>>go next (resize)>></A>";
    index3();
}


sub renamefiles_bareis {

    $FORM{goon} = "";
    $FORM{nrename} = 0;
    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir.$fname) && (($fname =~ /\.jpg$/i) || ($fname =~ /\.jpeg$/i))) { 
            my $newfname = "";
            if ($fname =~ /(.*?)\.(.*)/) {
                my $tname = $1;
                if ($tname =~ /(.*)_(\d+)/) {
                    $newfname = $1.chr(ord('a')+ $2).".jpg";
                }

                if ((!($tname =~ /_/)) && ($tname =~ /\d$/)){
                    $newfname = $tname.'a.jpg';
                }
                if ($newfname ne "" ) {
                    rename($tmp_dir.$fname, $tmp_dir.$newfname);
                }
                $FORM{nrename}++;
            }
        }
    }
    $FORM{goon} = "<BR><STRONG>".$FORM{nrename}." files renamed. <A HREF=\"".$FORM{script}."?action=resizefiles\">>>go next (resize)>></A>";
    index3();
}

sub renamefiles_gst {

    $FORM{goon} = "";
    $FORM{nrename} = 0;
    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir.$fname) && (($fname =~ /\.jpg$/i) || ($fname =~ /\.jpeg$/i))) { 
            my $newfname = "";
            if ($fname =~ /(.*?)\.(.*)/) {
                my $tname = $1;
                if ($tname =~ /(.*)_(\d+)/) {
                    $newfname = $1.chr(ord('a')+ $2 -1).".jpg";
                }
                if ($newfname ne "" ) {
                    rename($tmp_dir.$fname, $tmp_dir.$newfname);
                }
                $FORM{nrename}++;
            }
        }
    }
    $FORM{goon} = "<BR><STRONG>".$FORM{nrename}." files renamed. <A HREF=\"".$FORM{script}."?action=resizefiles\">>>go next (resize)>></A>";
    index3();
}

sub renamefiles_yuba {

    $FORM{goon} = "";
    $FORM{nrename} = 0;
    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir.$fname) && (($fname =~ /\.jpg$/i) || ($fname =~ /\.jpeg$/i))) { 
            my $newfname = "";

            if ($fname =~ /SUTTERYUBA(.*?)(.)\..*/) {
                $newfname = $1;     
                my $tname = $2;
                if (ord(lc($tname)) >= ord('a') && ord(lc($tname)) <= ord('y')) {
                    $tname = chr(ord(lc($tname))+1);
                }
                else {
                    $tname .= "a";
                }
                $newfname .= $tname.".jpg";
                if ($newfname ne "" ) {
                    rename($tmp_dir.$fname, $tmp_dir.$newfname);
                }
                $FORM{nrename}++;
            }
        }
    }
    $FORM{goon} = "<BR><STRONG>".$FORM{nrename}." files renamed. <A HREF=\"".$FORM{script}."?action=resizefiles\">>>go next (resize)>></A>";
    index3();
}



sub index3 {
    print "Content-type: text/html\n\n";
    index2();
}


sub index2 {

    $FORM{zipfilesoptions} = "";
    opendir(DIR, $zip_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $zip_dir.$fname) && (($fname =~ /\.zip$/i) || ($fname =~ /\.tar$/i))){
            $FORM{zipfilesoptions} .="<OPTION value=\"$fname\">$fname</OPTION>\n";
        }
    }

    $FORM{nunpack} = 0;
    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        if (-f $tmp_dir.$_) {
            $FORM{nunpack}++;
        }
    }

    loadtemplate($index);
    outputhtml();
}

sub do_convert {
    my ($inpath, $outpath, $filename, $neww , $newh) = @_;
    my $ImageOrg;

    $ImageOrg = newFromPng GD::Image($inpath.$filename, 1);
    if (!defined($ImageOrg)) {
        $ImageOrg = newFromJpeg GD::Image($inpath.$filename, 1);

    }

    if(defined($ImageOrg)) {
        my ($oldw, $oldh) = $ImageOrg->getBounds();

        #print "Content-type: image/jpeg\n\n";

        if (!$newh) {
            $newh = $oldh * $neww / $oldw;
        }

        if (!$neww) {
            $neww = $oldw * $newh / $oldh;
        }

        $im = new GD::Image($neww , $newh, 1);
        $im->copyResampled($ImageOrg, 0, 0, 0, 0, $neww, $newh, $oldw, $oldh);

        open(FILE, ">".$outpath.$filename);
        binmode (FILE);
        print FILE $im->jpeg;
        close(FILE);
        return 1;
    }
    else {
        return 0;
    }
}

sub postresizefiles {

    my ($inpath, $outpath, $neww , $newh);

    $neww = $FORM{width};

    if ($neww eq "") {
        $neww = 0;
    }
    if (!($neww =~ /^\d+$/)) {
        $FORM{error} .= "Invalid width. ";

    }

    $newh = $FORM{height};
    if ($newh eq "") {
        $newh = 0;
    }

    if (!($newh =~ /^\d+$/)) {
        $FORM{error} .= "Invalid height. ";

    }
    if ($FORM{error} ne "") {
        $FORM{error} = "Error: ".$FORM{error};
        resizefiles();
    }

    $inpath = $tmp_dir;
    $outpath = $tmp_dir2;

    if (!($inpath =~ /\/$/)) {
        $inpath .= "/";
    }

    if (!($outpath =~ /\/$/)) {
        $outpath .= "/";
    }

    if ($FORM{action} eq "postresizefiles") {
        $FORM{nresize} = 0;
        opendir(DIR, $inpath);
        @files = readdir(DIR);
        close(DIR);
        foreach (@files) {
            if (-f $inpath.$_) {
                unlink($outpath.$_);
            }
        }
    }

    opendir(DIR, $inpath);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        if (-f $inpath.$_) {
            #print $_."\n";
            if (!( -e  $outpath.$_ )) {
                if (($neww) || ($newh)) {
                    if (do_convert($inpath, $outpath, $_, $neww, $newh)) {
                        $FORM{nresize}++;
                        $FORM{lastfname} = $_;
                        if (! ($FORM{nresize} % $CONVERT_LIMIT)) {
                            do_resizecontinue();
                        }
                    }
                }
                else {
                    if (rename($inpath.$_, $outpath.$_)) {
                        $FORM{nresize}++;
                    }
                }
            }
        }
    }
    $FORM{goon} = "<BR><STRONG>".$FORM{nresize}." files resized. <A HREF=\"".$FORM{script}."?action=transferfiles\">>>go next (transfer)>></A>";
    resizefiles();
}

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

    loadtemplate($resizecontinue);
    outputhtml();

}

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

    $FORM{ntmp} = 0;
    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir.$fname)){
            $FORM{ntmp}++;
        }
    }

    $FORM{zipfilesoptions} = "";
    $FORM{nzip} = 0;
    opendir(DIR, $zip_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if (-f $zip_dir.$fname){
            $FORM{zipfilesoptions} .="<OPTION value=\"$fname\">$fname</OPTION>\n";
            $FORM{nzip}++;
        }
    }

    $FORM{ntransfer} = 0;
    opendir(DIR, $tmp_dir2);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir2.$fname) && ($fname =~ /\.jpg$/i)){
            $FORM{ntransfer}++;
        }
    }

    loadtemplate($transfer);
    outputhtml();

}

sub posttransferfiles {

    $FORM{ntransfered} = 0;
    $FORM{ntransfer} = 0;
    opendir(DIR, $tmp_dir2);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir2.$fname) && ($fname =~ /\.jpg$/i)){
            my $fdir = "";
            if ($fname =~ /(..).\.jpg$/) {
                $fdir = $1;
            }
            mkdir ($out_dir.$fdir);

            if (rename ($tmp_dir2.$fname, $out_dir.$fdir."/".$fname)) {
                $FORM{ntransfered}++;
            }
        }
    }

    $FORM{goon} = "<BR><STRONG>".$FORM{ntransfered}." files moved to /httpdocs/photos/ </STRONG>";
    transferfiles();
}

sub deletezipfiles {

    foreach (@delzipname) {
        my $fname = $_;
        if (-f $zip_dir.$fname){
            unlink($zip_dir.$fname);
        }
    }

    transferfiles();
}

sub deletetmpfiles {

    opendir(DIR, $tmp_dir);
    @files = readdir(DIR);
    close(DIR);
    foreach (@files) {
        my $fname = $_;
        if ((-f $tmp_dir.$fname)){
            unlink($tmp_dir.$fname);
        }
    }
    transferfiles();
}

sub main {

        %cookies = fetch CGI::Cookie;

    if ($ENV{'REQUEST_METHOD'} eq "GET") {
        $buffer = $ENV{'QUERY_STRING'};
    }
    elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }
    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs)
    {
        ($name, $value) = split(/=/, $pair);
        # Un-Webify plus signs and %-encoding
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        if ($name eq "delzipname") {
            push(@delzipname, $value);
        }
        else {
            $FORM{$name} = $value;
        }
    }

    $FORM{script} = $script;
    if ($FORM{action} eq "loginpost") {
        loginpost();
    }

    if (defined ($cookies{image_md5_hash})) {
        $image_md5_hash = $cookies{image_md5_hash}->value;
        $content = getpassword($password_file);
            my $ctx = Digest::MD5->new; $ctx->add($password);
            my $digest = $ctx->hexdigest;
        if ($digest ne $image_md5_hash) {
            login();
        }
    
    }
    else {
        login();
    }

    if ($FORM{action} eq "unzipfiles") {
        if ($FORM{zipname} =~ /\.zip$/) {
             unzipfiles();
        }
        if ($FORM{zipname} =~ /\.tar$/) {
            untarfiles();
        }
    }

    if ($FORM{action} eq "renamefiles") {
        renamefiles_gst();
    }

    if ($FORM{action} eq "resizefiles") {
        $FORM{width} = "340";
        $FORM{height} = "300";
        resizefiles();
    }

    if ($FORM{action} eq "postresizefiles") {
        postresizefiles();
    }

    if ($FORM{action} eq "transferfiles") {
        transferfiles();
    }

    if ($FORM{action} eq "posttransferfiles") {
        posttransferfiles();
    }

    if ($FORM{action} eq "deletetmpfiles") {
        deletetmpfiles();
    }

    if ($FORM{action} eq "deletezipfiles") {
        deletezipfiles();
    }

    if ($FORM{action} eq "postresizefiles_continue") {
        postresizefiles();
    }

    index3();

}

sharq

Дата 15.4.2006, 21:15 (ссылка)

(нет голосов)

Загрузка ...

Perl Liker

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 13.12.2004
Где: Ростов-на-Дону

Репутация: 2
Всего: 28

Acraft, смотри error.log +

Код


use CGI::Carp 'fatalsToBrowser';

--------------------

[color=gray]There's More Than One Way To Do It[/color]

nitr

Дата 15.4.2006, 22:56 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

На всякий поясню sharq'а

Код


use CGI::Carp 'fatalsToBrowser';

нужно для вывода ошибок "прямо в окно" браузера ;)

а error.log в каталоге Apache logs/error.log smile

--------------------

I love ArchLinux

Acraft

Дата 16.4.2006, 01:13 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 69
Регистрация: 19.4.2005

Репутация: нет
Всего: 2

там в скобках написано содержимое Апачевского error-лога...
Т.е. так и пишет: "Premature end of script headers". При выводе в браузер тоже: "Premature end of script headers".

Вообще, по работе приходится писать на PHP, но я все же наслышан, что сначала Perl передает заголовки, а потом уже код...ноги растут отсюда. А вот дальше не знаю.

nitr

Дата 16.4.2006, 01:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

)
возможно

Цитата

Короче, оказалось все просто smile

, а любой Win досовский редактор будет вставлять в конец строки именно CR+LF - на что сервер Unix отреагирует весьма озадачено и проинформирует в error log фразами “Premature end of script headers” т.к. не успеет добраться до Вашего print “Content-type: text/html\n\n"; smile

так что ... дерзайте ;)

Это сообщение отредактировал(а) nitr - 16.4.2006, 01:46

--------------------

I love ArchLinux

Acraft

Дата 17.4.2006, 10:39 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 69
Регистрация: 19.4.2005

Репутация: нет
Всего: 2

Цитата

Когда писал скрипт или вносил в скрипт изменения, то совсем забыл, что скрипт будет исполняться под Unix - а это значит… А это значит, что формат перевода строк там не CR+LF (как в Windows), а просто LF, а любой Win досовский редактор будет вставлять в конец строки именно CR+LF - на что сервер Unix отреагирует весьма озадачено и проинформирует в error log фразами “Premature end of script headers” т.к. не успеет добраться до Вашего print “Content-type: text/html\n\n";

Нет, скрипт писался в Vi. На всякий случай переписал верхнюю часть, не помогло.

Мне почему-то кажется что дело в какой-то настройке, потому что написал (в Vi) следующее:

Код


#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
print "Content-type: text/plain\n\n";
print "test";

или

Код


#!/usr/bin/perl
print "Content-type:text/html\n\n";
print "<html><head><title>HELLO</title></head>\n";
print "<body>\n";
print "<h2> This is a test message</h2>\n";
print "</body></html>\n";

.. и тоже "Premature end of script headers".

Это сообщение отредактировал(а) Acraft - 17.4.2006, 11:41

nitr

Дата 17.4.2006, 13:12 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

vi, это конечно хорошо.

Воспользуйся (почти везде есть) mcedit (и даже с подсветкой ;) )

Во фряхе всегда есть (мой любимый и простой) ee

Ну и можно глянуть здесь
и тут

Это сообщение отредактировал(а) nitr - 20.4.2006, 00:47

--------------------

I love ArchLinux

sharq

Дата 17.4.2006, 20:18 (ссылка)

(нет голосов)

Загрузка ...

Perl Liker

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 13.12.2004
Где: Ростов-на-Дону

Репутация: 2
Всего: 28

Acraft, попробуй через консоль

Цитата

perl -wc script_name.pl

Если все окей, то и запустить

Цитата

./script_name.pl

Я вот только что-то не понял, почему у тебя шабанг (т.е. #!) на второй строке во всех скриптах, это косяк вставки кода на форум или у тебя действительно так?

Иногда бывает на серверах косяк с файлами, что-то со временем или др...

Поэтому начни так экспериментировать:
создай через mc (Shift-F4) скрипт test.pl:

Код


#!/usr/bin/perl

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

Сохрани его, сделай исполняемым:

Цитата

chmod +x *.pl

Запусти через браузер, должен работать, если нет, то проверь error.log+путь к perl+на всякий и версию perl тоже и если не поможет, то пиши в саппорт, что у тебя элементарный perl-скрипт не работает.

Далее если все-таки заработало, то постепенно подключай модули, сохраняй проверяй, затем куски кода и т.д. до конца в итоге должен получится рабочий скрипт, либо ты найдешь косяк самого скрипта.

smile

Добавлено @ 20:19
На счет воторой строки - это косяк вставки кода на форум smile

--------------------

[color=gray]There's More Than One Way To Do It[/color]

korob2001

Дата 18.4.2006, 06:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

Репутация: 13
Всего: 61

Цитата

На счет воторой строки - это косяк вставки кода на форум

Я уже написал об этом в соответствующий раздел. Надеюсь скоро исправят. ;)))

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Sadok

Дата 19.4.2006, 11:12 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 74
Регистрация: 2.11.2004

Репутация: 1
Всего: 2

А путь к перлу правильно указан?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: разработка для Web \| Следующая тема »