📄 webftppages.pm
字号:
package WebFTPPages;use Carp;use strict;sub new { my $proto = shift; my $class = ref($proto) || $proto; unless (@_ == 6) { confess "WebFTPPages-: new(version, host, hostname, servername, scriptname, conf)" } my $self = {}; ($self->{VERSION}, $self->{HOST}, $self->{HOSTNAME}, $self->{SERVERNAME}, $self->{SCRIPTNAME}, $self->{conf}) = @_;# $self->{SCRIPT} = "$self->{conf}{HTTP}$self->{conf}{SERVERNAME}$self->{conf}{SCRIPT_NAME}"; $self->{SERVERPORT} = undef; $self->{CURRENTDIR} = '/'; bless ($self, $class); return $self;}sub updateDir { my($self, $dir) = @_; $self->{CURRENTDIR} = $dir;}sub getDir { my($self) = @_; $self->{CURRENTDIR};}sub setPort { my($self, $port) = @_; $self->{SERVERPORT} = $port;}sub loginScreen { my $self = shift; my($hostname); my @hn = split ',', $self->{conf}{ftphostname}; my @h = split ',', $self->{conf}{ftphost}; for(my $i=0; $i<=$#h; $i++) { $hn[$i] ||= $h[$i]; $self->{conf}{whathostname}{$h[$i]} = $hn[$i]; } $hostname = $hn[0] unless $#hn; my $out; $out = qq`<HTML> <META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <HEAD> <TITLE>Web-FTP $self->{VERSION} $hostname $self->{conf}{lang}{login}</TITLE> </HEAD> <BODY BGCOLOR="$self->{conf}{backgroundcolor}" TEXT="$self->{conf}{textcolor}" VLINK="$self->{conf}{visitedlinkcolor}" LINK="$self->{conf}{linkcolor}" ONLOAD="document.forms[0].elements[0].focus()">`; if(-f qq'$self->{conf}{base}/templates/loginheader') { open(D, qq'$self->{conf}{base}/templates/loginheader') or die $!; local $/; $out .= <D>; close D; } else { $out .= qq` <H1><A HREF="http://www.web-ftp.org/">Web-FTP</A> $self->{VERSION} $hostname $self->{conf}{lang}{login}</H1>`; } $out .= qq`<SCRIPT LANGUAGE=JAVASCRIPT>function next() { var i,j; var e = document.forms[0].elements; for(i = 0; i < e.length; i++) { if(e[i].type == 'text' || e[i].type == 'password') { if(e[i].value == '' && e[i].name != 'host') { e[i].focus(); i = 10; j = 1; } } } if(!j) document.forms[0].submit(); }</SCRIPT> <FORM METHOD=POST ACTION="$self->{conf}{SCRIPT}"> <TABLE BGCOLOR="$self->{conf}{logincolor}" ALIGN=CENTER BORDER=0 CELLSPACING=0 CELLPADDING=5>`; if($self->{conf}{language}) { my @lang = split /\s*,\s*/, $self->{conf}{language}; $out .= "<TR><TD>$self->{conf}{lang}{language}:</TD><TD>"; if($#lang) { $out .= qq`<SELECT NAME=language>`; for(@lang) { (my $l = $_) =~ tr/_/ /; $l = ucfirst($l); $out .= qq`<OPTION VALUE="$_">$l</OPTION>`; } $out .= "</SELECT>"; } else { $out .= $self->{conf}{current_lang} } $out .= "</TD>\n"; } if($#h > 0) { my $select = ''; for(my $i = 0;$i <= $#h;$i++) { $select .= qq`<OPTION VALUE="$h[$i]">$hn[$i]</OPTION>\n`; } $out .= qq`<TR><TD>$self->{conf}{lang}{host}:</TD><TD><SELECT ONCHANGE="next()" NAME="host">$select</SELECT></TD></TR>`; } elsif ($#h == -1) { $out .= qq`<TR><TD>$self->{conf}{lang}{host}:</TD><TD><INPUT ONCHANGE="next()" NAME="host"></TD></TR>`; } $out .= qq` <TR> <TD>$self->{conf}{lang}{username}:</TD> <TD><INPUT ONCHANGE="next()" NAME="username"></TD> </TR> <TR> <TD>$self->{conf}{lang}{password}:</TD> <TD><INPUT ONCHANGE="next()" NAME="password" TYPE=PASSWORD></TD> </TR> <TR> <TD COLSPAN=2 ALIGN=RIGHT> <INPUT TYPE=SUBMIT VALUE="$self->{conf}{lang}{login}"> </TD> </TR> </TABLE> </FORM> <P>`; if(-f qq'$self->{conf}{base}/templates/loginfooter') { open(D, qq'$self->{conf}{base}/templates/loginfooter') or die $!; local $/; $out .= <D>; close D; } else { $out .= $self->credits(); } $out .= qq` </BODY></HTML>`; return \$out;}sub MESSAGES { my $self = shift; my $out = qq`<HTML> <META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <META HTTP-EQUIV="Refresh" CONTENT="30; URL=$self->{conf}{SCRIPT}$self->{conf}{COOKIE}/MESSAGES"> <HEAD> <TITLE>$self->{conf}{lang}{msg_title}</TITLE> </HEAD> <BODY BGCOLOR="$self->{conf}{backgroundcolor}" TEXT="$self->{conf}{textcolor}" VLINK="$self->{conf}{visitedlinkcolor}" LINK="$self->{conf}{linkcolor}"> $self->{conf}{lang}{msg_help} <BR><A HREF="javascript:self.close()">$self->{conf}{lang}{close_window}</A><P>`; for(@{$self->{conf}{messages}}) { my $d = localtime($_->[0]); $d =~ /(\d\d:\d\d:\d\d)/; $out .= "<B>$1</B>: $_->[1]<BR>\n"; } $out .= qq` <P><A HREF="javascript:self.close()">$self->{conf}{lang}{close_window}</A> </BODY></HTML>`; \$out;}sub ACCT { my $self = shift; my $out; $out = qq`<HTML> <META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <HEAD> <TITLE>Web-FTP $self->{VERSION}: $self->{HOSTNAME} $self->{conf}{lang}{login}</TITLE> </HEAD> <BODY BGCOLOR="$self->{conf}{backgroundcolor}" TEXT="$self->{conf}{textcolor}" VLINK="$self->{conf}{visitedlinkcolor}" LINK="$self->{conf}{linkcolor}">`; if(-f qq'$self->{conf}{base}/templates/loginheader') { open(D, qq'$self->{conf}{base}/templates/loginheader') or die $!; local $/; $out .= <D>; close D; } else { $out .= qq` <H1><A HREF="http://www.web-ftp.org/">Web-FTP</A> $self->{VERSION}: $self->{HOSTNAME} $self->{conf}{lang}{login}</H1>`; } $out .= qq` <FORM METHOD=POST ENCTYPE="multipart/form-data" TARGET="_top" ACTION="$self->{conf}{SCRIPT}$self->{conf}{COOKIE}/POST"> <INPUT TYPE=HIDDEN NAME="action" VALUE="crypto"> <TABLE BGCOLOR="$self->{conf}{logincolor}" ALIGN=CENTER BORDER=0 CELLSPACING=0 CELLPADDING=5>`; $out .= qq` </TR> <TR> <TD>CRYPTOCard Challenge</TD> <TD>$self->{conf}{challenge}</TD> </TR> <TR> <TD>Response:</TD> <TD><INPUT NAME="response" TYPE=PASSWORD></TD> </TR> <TR> <TD COLSPAN=2 ALIGN=RIGHT> <INPUT TYPE=SUBMIT VALUE="$self->{conf}{lang}{login}"> </TD> </TR> </TABLE> </FORM> <P>`; if(-f qq'$self->{conf}{base}/templates/loginfooter') { open(D, qq'$self->{conf}{base}/templates/loginfooter') or die $!; local $/; $out .= <D>; close D; } else { $out .= $self->credits(); } $out .= qq` </BODY></HTML>`; return \$out;}sub failLogin { my $self = shift; \qq`<HTML> <META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <META HTTP-EQUIV="Refresh" CONTENT="5; URL=$self->{conf}{SCRIPT}"> <HEAD> <TITLE>$self->{conf}{lang}{login_failed}</TITLE> </HEAD> <BODY BGCOLOR="$self->{conf}{backgroundcolor}" TEXT="$self->{conf}{textcolor}" VLINK="$self->{conf}{visitedlinkcolor}" LINK="$self->{conf}{linkcolor}"> <H1>$self->{conf}{lang}{login_failed}</H1> <H3>$self->{conf}{lang}{login_failed_msg}</H3><PRE>$_[0]</PRE> </BODY></HTML>`;}sub permissionFailure { my $self = shift; my $OUT = qq`<HTML> <META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <HEAD> <TITLE>$self->{conf}{lang}{access_denied}</TITLE> </HEAD><BODY BGCOLOR="$self->{conf}{backgroundcolor}" TEXT="$self->{conf}{textcolor}" VLINK="$self->{conf}{visitedlinkcolor}" LINK="$self->{conf}{linkcolor}"><B><FONT COLOR="$self->{conf}{errorcolor}" SIZE=+1>$self->{conf}{lang}{unauthorized}</FONT></B> <P> $self->{conf}{lang}{please} <A HREF="$self->{conf}{HTTP}$self->{conf}{SERVERNAME}$self->{conf}{ORIG_SCRIPT_NAME}">$self->{conf}{lang}{login}</A> <I>$self->{conf}{lang}{with_cookies}</I>. </BODY></HTML>`; return \$OUT;}sub errorPage { my $self = shift; my $OUT = qq`<HTML> <META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <HEAD> <TITLE>Error</TITLE> </HEAD><BODY BGCOLOR="$self->{conf}{backgroundcolor}" TEXT="$self->{conf}{textcolor}" VLINK="$self->{conf}{visitedlinkcolor}" LINK="$self->{conf}{linkcolor}"><B><FONT COLOR="$self->{conf}{errorcolor}" SIZE=+1>$self->{conf}{lang}{error}</FONT></B><P>$_[0]<P><A HREF="$self->{conf}{SCRIPT}">$self->{conf}{lang}{click_here}</A> $self->{conf}{lang}{to_go} </BODY></HTML>`; return \$OUT;}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -