Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
Start · Board · Webprogrammierung mit Perl · Perl/CGI
[thread]10663[/thread]

Anfängerfrage: Upload mit Perl

Leser: 5


<< |< 1 2 >| >> 14 Einträge, 2 Seiten
knight
 2007-10-25 19:45
#101329 #101329
User since
2007-10-25
7 Artikel
BenutzerIn
[default_avatar]
Liebe Gemeinde!

ICH BIN PERL ANFAENGER! :-P

Folgendes Perl-Upload-Script erstellt 5-Dateien!

Bei 4 davon konnte ich die Rechte per "sysopen" auf 0777 setzen. Leider finde ich nicht die Stelle im Script wo er die finale Datei schreibt, somit kann ich für diese auch nicht 0777 setzen wie ich es aber dringend benötige :-(

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265

#!/usr/bin/perl -w

# PHP File Uploader with progress bar Version 2.0
# Copyright (C) Raditha Dissanyake 2003
# http://www.raditha.com
# Changed for use with AJAX by Tomas Larsson
# http://tomas.epineer.se/

# Licence:
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under this License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Initial Developer of the Original Code is Raditha Dissanayake.
# Portions created by Raditha are Copyright (C) 2003
# Raditha Dissanayake. All Rights Reserved.
#

# CHANGES:
# As of version 1.00 cookies were abolished!
# as of version 1.02 stdin is no longer set to non blocking.
# 1.40 - POST is no longer required and processing is more efficient.
#       Please refer online docs  for details.
# 1.42 - The temporary locations were changed, to make it easier to
#       clean up afterwards.
# 1.45.
#   Changed the way in which the file list is passed to the php handler
# 2.0  (2006-03-12) (Tomas Larsson)
#   Changed to work better with AJAX. This meant improved error handling
#       and no forwarding to php page after successful upload. Also moved settings
#       in to this file.
# 2.0  (2006-04-22) (Tomas Larsson)
#   Settings are now read from a file above document root (shared with PHP code)

use CGI;
use Fcntl qw(:DEFAULT :flock);
use File::Temp qw/ tempfile tempdir /;

$docroot = $ENV{DOCUMENT_ROOT};
# Settings file should be placed one step above document root.
# If you can't place it there, change the row below to point to the actual location of the settings file
$settingsfile = "upload_settings.inc";
if (-e $settingsfile)
{
    #Execute settingsfile (must be valid perl code)
    do $settingsfile;
}
if(!(-e $settingsfile) or !$max_upload or !$tmp_dir)
{
    #Default setting values
    $max_upload = 5000000;
    $tmp_dir="/tmp";
}

@qstring=split(/&/,$ENV{'QUERY_STRING'});
@p1 = split(/=/,$qstring[0]);

if("test" eq $p1[0]) {
    print "Content-type: text/html\n\n";
    print "Perl seems to be installed and working!<br />";
    print "<b>Settings</b><br />";
    print "Max upload size: ".$max_upload."<br />";
    print "Temp dir:        ".$tmp_dir."<br />";
    exit;
}

$sessionid = $p1[1];
$sessionid =~ s/[^a-zA-Z0-9]//g;  # sanitized as suggested by Terrence Johnson.

$async_upload = 1;
$size = @qstring;
if($size == 2) {
        @p2 = split(/=/,$qstring[1]);
        $target_url = @p2[1];
        $async_upload = 0;
}

# don't change the next few lines unless you have a very good reason to.

$post_data_file = "$tmp_dir/$sessionid"."_postdata";
$monitor_file = "$tmp_dir/$sessionid"."_flength";
$error_file = "$tmp_dir/$sessionid"."_err";
$signal_file = "$tmp_dir/$sessionid"."_signal";
$qstring_file = "$tmp_dir/$sessionid"."_qstring";


$len = $ENV{'CONTENT_LENGTH'};
$bRead=0;
$|=1;

sub bye_bye {
        $mes = shift;

        if($async_upload) {
                # Try to open error file to output message too
                $err_ok = open (ERRFILE,">", $error_file);
                if($err_ok) {
                        print ERRFILE $mes; #write message to file, so can be read from fileprogress.php
                        close (ERRFILE);
                } else {
                        # can't write error file. output alert directly to client
                        print "Content-type: text/html\n\n";
                        print "<html><head><script language=javascript>alert('Encountered error: $mes. Also unable to write to error file.');</script></head></html>\n";
                }
        } else {
                print "Content-type: text/html\n\n";
                print "<html><head><body><h1>Error</h1>Encountered error: $mes</body></html>\n";
        }
        exit;
}


# see if we are within the allowed limit.

if($len > $max_upload)
{
        close (STDIN);
        bye_bye("The maximum upload size has been exceeded");
}


#
# The thing to watch out for is file locking. Only
# one thread may open a file for writing at any given time.
#

if (-e "$post_data_file") {
        unlink("$post_data_file");
}

if (-e "$monitor_file") {
        unlink("$monitor_file");
}


sysopen(FH, $monitor_file, O_RDWR | O_CREAT, 0777)
        or &bye_bye ("Can't open numfile: $!");

# autoflush FH
$ofh = select(FH); $| = 1; select ($ofh);
flock(FH, LOCK_EX)
        or  &bye_bye ("Can't write-lock numfile: $!");
seek(FH, 0, 0)
        or &bye_bye ("Can't rewind numfile : $!");
print FH $len;
close(FH);

sleep(1);


# open(TMP,">","$post_data_file") or &bye_bye ("Can't open temp file");
# ssa
sysopen(TMP, $post_data_file, O_RDWR | O_CREAT, 0777) or &bye_bye ("Can't open temp file");

#
# read and store the raw post data on a temporary file so that we can
# pass it though to a CGI instance later on.
#



my $i=0;

$ofh = select(TMP); $| = 1; select ($ofh);

while (read (STDIN ,$LINE, 4096) && $bRead < $len )
{
        $bRead += length $LINE;

        select(undef, undef, undef,0.35);       # sleep for 0.35 of a second.

        # Many thanx to Patrick Knoell who came up with the optimized value for
        # the duration of the sleep

        $i++;
        print TMP $LINE;
}

close (TMP);

#
# We don't want to decode the post data ourselves. That's like
# reinventing the wheel. If we handle the post data with the perl
# CGI module that means the PHP script does not get access to the
# files, but there is a way around this.
#
# We can ask the CGI module to save the files, then we can pass
# these filenames to the PHP script. In other words instead of
# giving the raw post data (which contains the 'bodies' of the
# files), we just send a list of file names.
#

# open(STDIN,"$post_data_file") or &bye_bye("Can't open temp file");
# ssa
sysopen(STDIN, $post_data_file, O_RDWR | O_CREAT, 0777) or &bye_bye("Can't open temp file");

my $cg = new CGI();
my $qstring="";
my %vars = $cg->Vars;
my $j=0;

while(($key,$value) = each %vars)
{

        if(defined $value && $value ne '')
        {

                my $fh = $cg->upload($key);
                if(defined $fh)
                {
                        #carp $fh;                         
                        ($tmp_fh, $tmp_filename) = tempfile(DIR => $tmp_dir);

                        while(<$fh>) {
                                print $tmp_fh $_;
                        }
                        
                        close($tmp_fh);
                        
                        $fsize =(-s $fh);
                        
                        $fh =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
                        $tmp_filename =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
                        
                        $qstring .= "file[name][$j]=$fh&file[size][$j]=$fsize&";                        
                        $qstring .= "file[tmp_name][$j]=$tmp_filename&";
                        
                        $j++;
                }
                else
                {
                        $value =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
                        $qstring .= "$key=$value&" ;
                }
        }
}


# open (SIGNAL,">", $signal_file) or &bye_bye ("Can't open signal file");
# ssa
sysopen(SIGNAL, $signal_file, O_RDWR | O_CREAT, 0777) or &bye_bye ("Can't open signal file");

print SIGNAL "\n";
close (SIGNAL);

# open (QSTR,">", "$qstring_file") or &bye_bye ("Can't open output file");
# ssa
sysopen(QSTR, $qstring_file, O_RDWR | O_CREAT, 0777) or &bye_bye ("Can't open signal file");

print QSTR $qstring;
close (QSTR);

if($async_upload) {
        print "Content-type: text/html\n\n";
        print "<html></html>";
} else {
        $url = $target_url . "?sid=$sessionid";
        print "Location: $url\n\n";
}


Ich würde mich sehr freuen wenn ihr mir helfen könntet :-)

Danke knight
GwenDragon
 2007-10-25 19:49
#101330 #101330
User since
2005-01-17
14542 Artikel
Admin1
[Homepage]
user image
Du solltest übrigens nicht nur das sysopen überprüfen sondern auch das close!

Also z. B. anstatt
Code (perl): (dl )
close (SIGNAL);
besser
Code (perl): (dl )
close (SIGNAL) or die( $!);
die Drachin, Gwendolyn

Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel
knight
 2007-10-25 19:59
#101331 #101331
User since
2007-10-25
7 Artikel
BenutzerIn
[default_avatar]
Danke für die Info!

Das löst mein Problem mit der mysteriösen 5-ten Datei leider nicht???

Wo kann ich für diese die Rechte setzen?

Er erstellt ja de facto 5 Stück...

7b77a2e5d1709b8e2dd61bdbed6f2207_flength
7b77a2e5d1709b8e2dd61bdbed6f2207_postdata
7b77a2e5d1709b8e2dd61bdbed6f2207_qstring
7b77a2e5d1709b8e2dd61bdbed6f2207_signal

UND:

tM883x2hVO

(Woher der Filename kommt weiß ich leider nicht, ist ein automatisch generierte ID vermute ich)

Und genau für diese Datei muss ich die Rechte auf 0777 setzen. Bei allen anderen klappt es durch die "sysopen"-Befehle...

:-( *verzweifelt*
GwenDragon
 2007-10-25 20:05
#101332 #101332
User since
2005-01-17
14542 Artikel
Admin1
[Homepage]
user image
Du erzeugst ab Zeile 218 eine temporäre Datei. Du weißt, dass die nur existiert solange das Skript läuft?
die Drachin, Gwendolyn

Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel
knight
 2007-10-25 20:06
#101333 #101333
User since
2007-10-25
7 Artikel
BenutzerIn
[default_avatar]
"Du weißt, dass die nur existiert solange das Skript läuft?"

Ja weiß ich :-) wie lautet der "sysopen" Befehl in diesem Fall??????? :-) :-) :-)

Und zwischen welche Zeile muss ich ihn setzen?

BZW. ein anderer Befehl der den chmod auf 0777 setzt?

Danke danke für deine Hilfe :-) Ich mach hier echt seit Stunden rum und bin am Haare ausreißen ^^
GwenDragon
 2007-10-25 20:14
#101334 #101334
User since
2005-01-17
14542 Artikel
Admin1
[Homepage]
user image
Die Dokumentation sagt bei CGI:
Quote
The temporary file is created with mode 0600 (neither world nor group readable).


tM883x2hVO wird als temporäre Datei vom CGI-Upload erzeugt und hat die Dateirechte 0600.
die Drachin, Gwendolyn

Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel
knight
 2007-10-25 20:17
#101335 #101335
User since
2007-10-25
7 Artikel
BenutzerIn
[default_avatar]
Das bedeutet es geht gar nicht?
GwenDragon
 2007-10-25 20:19
#101336 #101336
User since
2005-01-17
14542 Artikel
Admin1
[Homepage]
user image
Mit
Code (perl): (dl )
1
2
3
4
5

($tmp_fh, $tmp_filename) = tempfile(DIR => $tmp_dir);
while(<$fh>) {
  print $tmp_fh $_;
}
close($tmp_fh);
schreibst du ja das hochgeladenene in die temporäre Datei.

Welche Dateien müssen denn für später bestehen bleiben?

Wenn du anstatt
Code (perl): (dl )
($tmp_fh, $tmp_filename) = tempfile(DIR => $tmp_dir);
dann
Code (perl): (dl )
($tmp_fh, $tmp_filename) = tempfile(DIR => $tmp_dir, UNLINK=>0);
verwendest, bleibt die Datei mit dem Dateinamen $tmp_filename erhalten.

Erklär doch mal, was das Programm machen soll.
die Drachin, Gwendolyn

Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel
pq
 2007-10-25 22:01
#101343 #101343
User since
2003-08-04
12208 Artikel
Admin1
[Homepage]
user image
knight+2007-10-25 17:45:59--
Code (perl): (dl )
1
2
3

#!/usr/bin/perl -w

# PHP File Uploader with progress bar Version 2.0

hmm... das sieht verdächtig aus... =)
Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live. -- Damian Conway in "Perl Best Practices"
lesen: Wiki:Wie frage ich & perlintro Wiki:brian's Leitfaden für jedes Perl-Problem
GwenDragon
 2007-10-25 22:45
#101350 #101350
User since
2005-01-17
14542 Artikel
Admin1
[Homepage]
user image
Ja, sieht verdächtig danach aus, dass ein PHP-Skript + Ajax verwendet werden soll, das ich nicht kenne.

//EDIT: http://tomas.epineer.se/tesupload/
:P
die Drachin, Gwendolyn

Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel
<< |< 1 2 >| >> 14 Einträge, 2 Seiten



View all threads created 2007-10-25 19:45.