论坛: 编程破解 标题: perl编程(要求收入精华区) 复制本贴地址    
作者: 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定值回�鳌H绻�有�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号