読者です 読者をやめる 読者になる 読者になる

ゴミ置き場

Perl
  • CGI.pm、CGI::Session、HTML::Template、Digest::MD5を使ったサンプル

書いている最中に仕様が変わってしまい無駄になってしまったが今後も使うかもしれないのでメモとして残しておく。

#!/usr/bin/perl -T

use strict;
use CGI;
use CGI::Session;
use HTML::Template;
use Digest::MD5;

my $cgi = new CGI;
my $session = new CGI::Session("driver:File", undef, {Directory=>'/tmp'});
my $CGISESSID = $session->id();

my $tmpl;

if('step1' eq $cgi->param('page')){
	if( is_valid($cgi->param('DOMAIN'), $cgi->param('COOKIE')) ){
		$session->param('is_valid', '1');
	}
	
	$tmpl = HTML::Template->new(filename => 'democlr_step1.tmpl');
	my $demodomains = get_demo_domains();
	$tmpl->param(DEMODOMAIN => $cgi->popup_menu(-name=>'demodomain', -values=>$demodomains, -default=>$$demodomains[0]) );
	$session->param('is_valid', '1');
}
elsif('step2' eq $cgi->param('page')){
	my $is_valid = $session->param('is_valid');
}
else{
}

my $ctx = Digest::MD5->new;
$ctx->add("mariners");

print $cgi->header(
	-type=>'text/html',
	-expires=>'+3d',
);
print $tmpl->output;

#print $q->start_html(-title=>'democlean', -bgcolor=>'#FFFFFF');
#print $ctx->hexdigest;
#print $q->end_html;

cleanup( "/www/a-mail/satoru.com/public_html/whatsnew" );

sub cleanup{
	my ( $dir ) = @_;
	$dir = untaint_filename( $dir );
	chdir( $dir ) or die "cant change dir: $dir";
	opendir(DIR, ".");
	my @tmp = sort readdir(DIR);
	my @file;
	foreach (@tmp){
		push @file, $_ if $_ ne '.' && $_ ne '..';
	}
	my $file;
	foreach $file (@file){
		if( -d $file ){
			cleanup($file);
			rmdir( untaint_filename($file) );
		}
		else {
			unlink( untaint_filename($file) );
		}
	}
	chdir( ".." ) or die "cant change dir: ..";
	return;
}

sub untaint_filename{
	my $re_filename =  qr/.*/;
	my $name = shift;
	die "$name is insecure" unless $name =~ /^($re_filename)$/;
	return $1;
}

sub is_valid{
	my($domain, $cookie)=@_;
	open(FH, "/www/script/data/userdb") || die "can't open /www/script/data/userdb .";
	while(<FH>){
		chomp;
		my ($dmn, $user, $ck) = split /,/;
		if($domain eq $dmn && $cookie eq $ck){
			return 1;
		}
	}
	0;
}

sub get_demo_domains{
	open(FH, "democlr.data") || die "can't open democlr.data .";
	my @demodomains;
	while(<FH>){
		chomp;
		push @demodomains, $_;
	}
	\@demodomains;
}
  • md5のところだけ
use Digest::MD5;
print Digest::MD5->new()->add("ABCDE")->hexdigest;
  • PerlPOP3サーバーにアクセスしてメールを取り出すサンプル
use strict;
use Net::POP3;

my $host='pop.mail.yahoo.com';
my $username='yukio1980';
my $password='5963abc';

my $pop = Net::POP3->new($host);

if ($pop->login($username, $password) > 0) {
	my $msgnums = $pop->list;
	my $i=1;
	foreach my $msgnum (keys %$msgnums) {
		my $msg = $pop->get($msgnum);
		open(FH, ">$host" . "_" . "$i.eml");
		print FH <<END_OF_MAIL
@$msg
END_OF_MAIL
;
		close(FH);
		$i++;
	}
}
else {
	print "login failed.";
}


  • gethostbyname の使い方
print join('.', unpack('C*', gethostbyname 'rukatan.com') );
  • Encode.pm のfrom_to を使ったCGIのサンプル

euc-jpの文字列をutf-8に変換して表示する。

#!/usr/bin/perl

use strict;
use CGI;
use Encode qw(from_to);

my $q = new CGI;

print $q->header( -type=>'text/html', -charset=>'utf-8' );
my $s = $q->param('s');
from_to( $s, 'euc-jp', 'utf8');
print $s;
  • LWP::UserAgent の使い方のサンプル
use LWP::UserAgent;

sub get_contents {
        my($url) = shift;
        my $ua = LWP::UserAgent->new;
        my $res = $ua->get($url);
        return $res->content;
}
  • Net::FTP の使い方サンプル
#!/usr/bin/perl

use strict;
use Net::FTP;

if(@ARGV < 4 ){
	die "usage: perl putfile.pl ftphostname username password filepath", "\n";
	
}

putFile( $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3] );

sub putFile {
	my($hostname, $username, $password, $filepath)=@_;
	my $ftp = Net::FTP->new($hostname, Debug => 0);
	$ftp->login($username, $password) or die "Cant login $hostname, $username, $password";
	#$ftp->cwd("");
	#$ftp->get("that.file");
	$ftp->put($filepath) or die "couldnt put " . $filepath;
	$ftp->quit;
}