|
 | 作者: Linux [god_father]
 论坛用户 |
登录 |
| 声明：此贴为转贴，版权归作者 发现几篇关于perl编程的好文章，拿来与大家共享 希望对爱好perl的朋友有所帮助！ [1] Blowfish模块 作者：hoowa 总在这里问东西也不能不给这里的朋友点东西 这是我刚刚做的，给你资料你整理一下就可以用了：） Blowfish是一个强壮的可变长度由8个字节到56个字节(448位钥匙)的加密技术。 只有在双方持有相同的钥匙情况下才有可能解密数据。 他照比DES算发具有更高的安全性(目前无法破解)。 而且他的加密速度是最快的！ 这里不讲他如何做的算法。我们只讲Crypt::Blowfish如何使用。 安装： win32系统： 输入ppm命令，然后输入install Crypt::Blowfish回车等待安装结束，或search blowfish查看列表。 Linux下请到www.cpan.org下载模块，编译安装需要gcc 此模块是使用的最小8字节长度，最大56字节长度，在编写钥匙的时候如果不符合这个范围那么就将出现错误。 在加密的时候，需要将所加密的字符穿分割成为多个8字节长度的字符串，如果不够8字节可以填充空格等特殊字符。 以下是举例： 代码: #!/usr/bin/perl use Crypt::blowfish; #加载模块 #需要加密的资料 $data = qq~欢迎光临www.ilcatperl.org这里是Perl的天堂 欢迎喜欢Perl 如果你觉得Perl不行，那就是你水平太臭,回家看孩子玩吧~; #构造对象 my $fish = new Crypt::Blowfish 'this is my key'; # 8 bytes < Key > 56 bytes #编码 @data = &block($data); #将数据以8个字节块化，如果最后不够补充空格 foreach (@data) { $encode .= $fish->encrypt($_); } #解码 @data = &block($encode); #将数据以8个字节块化，如果最后不够补充空格 foreach (@data) { $decode .= $fish->decrypt($_); } #块化子程序 sub block { my ($string) = @_; my (@blocks,$last_length,$nu,$ad); my @blocks = unpack("a8 "x(int(length($data)/) . "a*", $string); $last_length = length($blocks[$#blocks]); if (($nu = 8 - $last_length) > 0) { for (my $i=1;$i<=$nu ;$i++) { $ad .= ' '; } } $blocks[$#blocks]= $blocks[$#blocks].$ad; return(@blocks); } #以上代码encode是编码后decode是解码后 #coding by hoowa [此贴被 286(unique) 在 04月30日09时27分 编辑过] |
| 地主 发表时间: 04-04-30 09:20 |
 | 回复: 286 [unique]  版主 |
登录 |
|
[2] 父进程与子进程communicate..利用PIPE的例子 作者：apile # 本程序主要利用PIPE来建立Parent Process与Child Process间的互相连通， # 利用%STATUS纪录目前Child Process的所有状态，与%CHILDREN纪录所有的Child # Process。 # Parent Process：负责由CHILD_READ中读取所有CHILD Process的输入，并纪录 # 这些Process目前的状态。当收到INT、HUP、TERM等Signal时，即跳出主要loop # 并将所有child Process全部杀光... 代码: #!/usr/bin/perl use strict; use IO::Select; use POSIX qw(WNOHANG); #---Define constants：定义准备先fork几个Process use constant PREFORK_CHILDREN => 3; # debugging information：显示过程 use constant DEBUG => 1; # declare globals my $DONE=0; # set flag to true when server done my %STATUS = (); #child status information, child pid form keys of the ha sh, status form the values #--- 纪录所有Child Process的id... my %CHILDREN = (); #---Interrupt handles,跳出loop $SIG{TERM} = $SIG{INT}=$SIG{HUP} = sub { $DONE++ }; #--- get CHLD Signal $SIG{CHLD} = sub { while((my $child=waitpid(-1,WNOHANG)) > 0){ delete $CHILDREN{$child}; } }; # create a pipe for IPC：建立PIPE pipe(CHILD_READ,CHILD_WRITE) or die "Can't make pipe!\n"; my $IN = IO::Select->new(\*CHILD_READ); # prefork some children make_new_child() for (1..PREFORK_CHILDREN); # main loop while(!$DONE){ # avoid parent block in the I/O call if ($IN->can_read){ # got a message from one of the children my $message; next unless sysread(CHILD_READ,$message,4096); # may contain several messages my @messages = split "\n",$message; # retrive every pid and status code foreach (@messages){ next unless my ($pid,$status) = /^(\d+) (.+)$/; # change status if($status ne "done"){ $STATUS{$pid} = $status; }else{ # delete pid delete $STATUS{$pid}; } } } warn join(' ',map {"$_=>$STATUS{$_}"} keys %STATUS),"\n" if DEBUG; last unless %CHILDREN } warn "Termination received, killing children\n" if DEBUG; #-------------杀掉所有Child Process kill TERM => keys %CHILDREN; sleep while %CHILDREN; warn "Normal termination.\n"; exit 0; #---- 建立新的Process sub make_new_child{ die "can't fork :$!" unless(defined( my $child = fork())); if($child){ # child > 0, so we're the parent $CHILDREN{$child} = 1; warn "launching child $child\n" if DEBUG; }else{ close CHILD_READ; # no need to read from pipe do_child(); # child handles incoming connections exit 0; # child is done } } #------ child process sub do_child{ # write status code: idle syswrite CHILD_WRITE,"$$ idle\n"; for(1..1000000){ }; syswrite CHILD_WRITE,"$$ busy\n"; for(1..1000000){ }; syswrite CHILD_WRITE,"$$ done\n"; } |
| B1层 发表时间: 04-04-30 09:24 |
| 回复: 286 [unique] 版主 |
登录 |
|
[3] 父进程与子进程communicate..利用IPC::Shareable的例子 作者：apile Hi...�@是昨天那��例子改用share memory的方式，�上啾容^..我�X得 PIPE比�^好�c...尤其是有大量�Y料需要互�鞯��r候... --------------------------------------------------------------------------------- 本程序主要使用IPC::Shareable module来建立一块共同的share memory 以为所有程序所用，主要利用tie将%STATUS、%status与IPC::Shareable tie在一起，其中SHM_GLUE用来向OS做注册一块memory的�R�e符��，因 此若程序失败， 未能正常清除share memory，必须利用OS提供的share memory工具清除， 否则程序将无法启动。linux可以使用ipcrm清除 Parent Process利用sleep()，不做任何动作，而child Process的状态， 透过kill -ALARM getppid() 通知Parent，child Process的status已经 改变了.. ----------------------------------------------------------------------- 代码: #!/usr/bin/perl -w # p_shm.pl #---- 加载 module包含IPC::Shareable use strict; use POSIX qw(WNOHANG); use IPC::Shareable; #---- 定义常数 use constant PREFORK_CHILDREN => 3; #--- 定义识别文字 use constant SHM_GLUE => 'PERF'; #--- 查测过程 use constant DEBUG => 1; #--- 宣告全域变量 my $DONE = 0; # set flag to true when server done #--- 纪录CHILD的STATUS my %STATUS = (); my %CHILDREN=(); #--- 抓取Signal INT,TERM,ALRM---- $SIG{INT} = $SIG{TERM}= sub{ $DONE++ }; $SIG{ALRM} = sub {}; # receive alarm clock signals, but do nothing #----抓取 signal : CHLD $SIG{CHLD} = sub { while((my $child=waitpid(-1,WNOHANG)) > 0){ delete $CHILDREN{$child}; } }; # create a shared memory segment for child status tie(%STATUS,'IPC::Shareable',SHM_GLUE, { create =>1,exclusive=>1,destroy=>1,mode=>0600}) or die "Can't tie \%STATUS to shared memory: $!"; # prefork some children make_new_child() for(1..PREFORK_CHILDREN); # prefork children #-- Main loop while(!$DONE){ sleep; # sleep until a signal arrives(alarm clock or child) # get the list of idle children warn join(' ',map{"$_=>$STATUS{$_}"} keys %STATUS),"\n" if DEBUG; unless(%CHILDREN){ last; } } warn "Termination received, killing children\n" if DEBUG; #-------------杀掉所有Child Process kill TERM => keys %CHILDREN; sleep while %CHILDREN; warn "Normal termination.\n"; exit 0; #---- 给launch_child cleanup child code sub make_new_child{ die "can't fork :$!" unless(defined( my $child = fork())); if($child){ # child>0, so we're the parent warn "launching child $child\n" if DEBUG; $CHILDREN{$child} = 1; }else{ do_child(); # child handles incoming connections exit 0; # child is done } } #--- 执行accept() loop fro each child --- sub do_child{ my %status; #--将%status与IPC::Shareable tie在一起 tie(%status,'IPC::Shareable', SHM_GLUE) or die "Child $$: can't tiel \%status to shared memory: $!"; #----告知Parent Process，child process 状态已经改变 $status{$$} ='idle'; kill ALRM=>getppid(); for(1..1000000){ } #----告知Parent Process，child process 状态已经改变 $status{$$} ='busy'; kill ALRM=>getppid(); #----告知Parent Process，child process 状态已经改变 for(1..1000000){ } $status{$$} = 'done'; kill ALRM=>getppid(); warn "child $$: done\n" if DEBUG; } #---- delete the child's PID from %STATUS. sub cleanup_child{ my $child=shift; delete $STATUS{$child}; } |
| B2层 发表时间: 04-04-30 09:25 |
| 回复: 286 [unique] 版主 |
登录 |
|
[4] �槭颤N要用IO::Poll？因�槭褂�IO::Select�r候，因�槠��Υ�handle是存在。。。。。。 作者：apile 以下�Y料�楸救碎��xNework Programming With Perl的��要.. 有�d趣的自己研究研究... ============================================= date: 2003/06/22 IO::Poll的使用�f明： 在5.6版本的�r候�_始�l展，功能完整的版本��0.04版。所以要注意的是IO::Poll版本一定要是0.04以上。 �槭颤N要用IO::Poll？因�槭褂�IO::Select�r候，因�槠��Υ�handle是存在bit vector�e面，因此必�����λ�有�O控中的Handle一��一��去Scan，找出可以Read/Write的handle。因此在效能的Issue上，��遇到大量的handle需要�O控�r，就���a生效能上的降低。而IO::Poll的�C制�t不是�@�N回事，他同�涌梢员O控大量的HANDLE，但是利用array�Υ孢@些handle，因��array的�Υ��C制，�K不同於bit vector，�K不需要一��一��去Scan�@些handle，所以在效能上比�^好。 IO::Poll只需要一��Object就可以��理所有的handle，透�^bitmask��Event�鹘o被�O控的Handle，一旦符合需求，可以��handle中取出。 IO::Poll接受的Event(mask)： 可�x的 POLLIN:一般�c有Priority的�Y料 POLLRDNORM：一般的�Y料 POLLRDBAND：有Priority的�Y料 POLLPRI：特�e高的Priority 可��的 POLLOUT：一般�c有Priority的�Y料 POLLWRNORM：一般的�Y料 POLLWRBAND：有Priority的�Y料 有�e�`的 POLLHUP：HangUp�l生 POLLNVAL：handle不合法 POLLERR：有Error�l生，如果是Socket可用sockopt(SO_ERROR)取得Error�热� IO::Poll的method 1.$poll=IO::Poll->new()：�a生IP::Poll的Object 2.$mask=$poll->mask($handle,[$mask]) 取得或�O定目前handle的 event bitsmask，如果mask�]�o，�t目前的�O定值回�鳌Ｈ绻�有�omask�t�⒃�mask�O定�o��handle。如果mask��0，�t��list�⒃�handle移除。所有的handle�A�O都���O控(POLLNVAL、POLLERR、POLLHUP）。 3.$poll->remove($handle) 同$poll->mask($handle,0); 4.$events=$poll->poll([$timeout]) 等候有任何一���O控中的handle可以被�x取或��入。回��Event Type。 5.@handles=$poll->handles([$mask]) 取出符合mask的handles。 6.$mask = $poll->events($handle) 取得$handles的所有mask。 代码: #!/usr/bin/perl # file : test.pl # usage: test.pl [host] [port] # 利用IO::Poll�_到多工的技�g #--加�dmodule use strict; use IO::Socket; #--引用後面的constant use IO::Poll qw( POLLIN POLLOUT POLLERR POLLHUP); use Errno qw(EWOULDBLOCK); #--�O定Buffer的最大值 use constant MAXBUF =>8192; #--忽略掉HANG HUP的Signal $SIG{PIPE} = 'IGNORE'; #--�O定全域���担�����buffer����flag my ( $to_stdout,$to_socket,$stdin_done,$sock_done); #--取得 host and port my $host = shift or die "Usage: test.pl host [port]\n"; my $port = shift || 'echo'; #--建立Socket my $socket = IO::Socket::INET->new("$host:$port") or die $@; my $poll = IO::Poll->new() or die "Can't create IO::Poll object"; #--一�_始先��STDIN�c$socket放入list中，�K�⑵�mask�O定��POLLIN���渥x取。 $poll->mask(\*STDIN => POLLIN); $poll->mask($socket => POLLIN); #--�O定���瘦�出�c$socket��noblocking mode $socket->blocking(0); # turn off blockingon the socket STDOUT->blocking(0); # and on STDOUT #--main loop，$poll->handles��回�魉�有正在�O控中的handle while($poll->handles){ #--等候直到有事件符合 $poll->poll; # ��理可�x取的事件 for my $handle ($poll->handles(POLLIN|POLLHUP|POLLERR)){ if($handle eq \*STDIN){ #?#93;�Y料�x取表示STDIN已���K止，否�t�①Y料放入to_socket buffer中 $stdin_done++ unless sysread(STDIN,$to_socket,2048,length $to_socket); } elsif($handle eq $socket){ # ?#93;�Y料�x取表示Socket已���x取完��，否�t�①Y料附入to_stdout buffer中 $sock_done++ unless sysread($socket,$to_stdout,2048,length $to_stdout); } } # ��理可��入的事件 for my $handle ($poll->handles(POLLOUT|POLLERR)){ if($handle eq \*STDOUT){ my $bytes = syswrite(STDOUT,$to_stdout); # 假若不是EWOULDBLOCK，表示真的有Error�l生，所以才�o法��入 unless ($bytes){ next if $! == EWOULDBLOCK; die "write to stdout failed: $!"; } # 如果�l生Partial Write�⒁呀���出的先清掉。 substr($to_stdout,0,$bytes) = ''; } elsif($handle eq $socket){ my $bytes = syswrite($socket,$to_socket); unless ($bytes){ next if $! == EWOULDBLOCK; die "write to socket failed: $!"; } substr($to_socket,0,$bytes) = ''; } } } continue { # 每次While loop�绦��r都���绦械竭@�� # 先�O定三��bitmask��0，表示����list中�⒃�handle移除 my ($outmask,$inmask,$sockmask) = (0,0,0); # �O定stdout的mask，假如有�Y料要��出去，�t�⑵�mask�O�榭���(POLLOUT) $outmask = POLLOUT if length $to_stdout > 0; # �� to_socket的�Y料�L度比MAXBUF大、或socket已��完�Y # 或stdin已��完�Y，都不成立�r，�t�O定STDIN可�x取。 $inmask = POLLIN unless length $to_socket >= MAXBUF or ($sock_done || $stdin_done); # 假如有�Y料要��出去，�O定$socket��POLLOUT（待��) $sockmask = POLLOUT if length $to_socket>0; # 同STDIN定�x，但是|=表示附加上去，因��Socket可以同�r�x�� $sockmask |= POLLIN unless length $to_stdout>=MAXBUF or $sock_done; # �O定STDIN、STDOUT、Socket三��handle的bitmask $poll->mask(\*STDIN => $inmask); $poll->mask(\*STDOUT=> $outmask); $poll->mask($socket => $sockmask); # 如果$stdin_done�檎媲乙呀�?#93;有�Y料送出至$socket了，�t��$socket �P?#93; $socket->shutdown(1) if $stdin_done and !length($to_socket); } |
| B3层 发表时间: 04-04-30 09:26 |
|
20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写：NetDemon
粤ICP备05087286号
论坛: 编程破解
标题: perl编程（要求收入精华区）