Perl多线程

 

1. 多线程的概念

    多线程的概念在所有操作系统的书总都有讲到，所谓多线程是这样一种机制，它允许在程序中并发执行多个指令流，每个指令流都称为一个线程，彼此间互相独立。线程又称为轻量级进程，它和进程一样拥有独立的执行控制，由操作系统负责调度，区别在于线程没有独立的存储空间，而是和所属进程中的其它线程共享一个存储空间，这使得线程间的通信远较进程简单。多个线程的执行是并发的，也就是在逻辑上“同时”，而不管是否是物理上的“同时”。如果系统只有一个CPU，那么真正的“同时”是不可能的，但是由于CPU的速度非常快，用户感觉不到其中的区别，因此我们也不用关心它，只需要设想各个线程是同时执行即可。

1. Perl的多线程

目前Perl多线程有3个模块，POE模块，Thread模块，threads模块。POE模块经过李昕前期的分析，认为不太好用，不太容易理解，有时候会出现CPU高的问题。而Thread模块由于不稳定性和windows平台下的缺陷，目前已经被threads模块替代，目前CPAN主要推荐的是threads模块。

threads模块主要涉及threads和threads::shared两个主要模块

1. threads模块介绍

threads基于一个不同于Thread的多线程模型---解释器多线程，从Perl v5.6.0开始支持，目前我们PAT使用的版本是Perl v5.8.7。在这个模型中，每个线程运行在自己的perl解释器中，默认情况下，各个线程间不共享变量。如果需要在线程间共享变量需要明确指出（采用threads：：shared）。注意，这和我们平常理解的多线程模型有所不同，编码时要特别注意这一点。

下面介绍下threads多线程的一些关键内容：

1.   采用create或者new方法来创建线程

Use threads;

$thr = threads->new(\&sub1, "Param 1", "Param 2");

Sub sub1 {

     My @para = @_;

     Print “Get parameters:”,join(“,”,@para),”\n”;

}

1. 等待1个线程退出，采用join方法，如my $return = $thr->join;

注意join完成3件事: 等待线程结束，线程结束后进行垃圾收集，返回线程的返回值

1. Detach方法。如果需要开启线程后不再管他，让其自行后台运行，可以采用detach的方式。该方式不能像join一样获取返回值等。
2. 线程间共享数据

前面我们说过，如果Perl线程间需要进行数据的访问，需要对变量进行显式声明。例子：

use threads;

use threads::shared;

my $shared_var:shared = 1;

my $unshared_var = 1;

threads->new(sub {$shared_var++;$unshared_var++;})->join;

print $shared_var;     ＃由于这个变量是共享的，所以它的值为2

print $unshared_var;   ＃由于这个变量不是共享的，所以它的值为1

 

当然，共享的数据不仅仅可以是简单变量，还可以是数组，列表，hash等

1. Lock锁定功能，在修改一个共享变量时，最好先lock

lock一个变量后，在本代码块结束后才会释放。所以lock最好这样写:

#前面的操作

…

#对共享变量的操作

{

Lock($shared_var);

…

}

#后面的操作

…

1. yield

线程可以通过yield来主动放弃CPU，将CPU资源让给其他线程。

1. 其他，比如PV信号量实现线程的同步等
2. 多线程模型的缺点

Races不确定性

死锁问题

 

 

脚本示例

1.简单示例

#以下示例：一个线程持续检测网卡1，捕获到dns请求报文则回应dns响应报文(模拟一个DNS服务器)，另外一个线程持续发送普通二层报文(模拟攻击)，主线程进行ping www.test.com的操作

 

#载入所需要使用的模块

use threads;

use threads::shared;

require("common.pl");

require("test_common.pl");

 

#定义线程间的共享变量

our $hostname:shared = "S3760";

our @choice:shared;

    $choice[0] = 3;

our $stop_flag:shared = 0;

 

my ($error,%devinfo);

my @adapts = Net::Pcap::findalldevs(\$error,\%devinfo);                                                  

my $pcap = Net::Pcap::open_live($adapts[2], 1518, 1, 1, \$error);

 

#创建两个线程，一个发送二层报文，一个模拟dns服务器

$thr1 = threads->create('Send_L2Packets',"");

$thr2 = threads->create('Deal_Dns',"");

#detach方法表示不关心两个线程的返回值，不需要等待返回

$thr1->detach;

$thr2->detach;

 

#主线程在控制台进行ping www.test.com操作

my $content = Send_Cmd_Command("ping www.test.com");

while(1) {

    my $temp = Send_Cmd_Command("");

    $content = $content.$temp;

    if ($temp =~ /$hostname/) {

        last;

    }

}

print $content;

#通知其他线程结束

$stop_flag = 1;

 

#检测其他线程已经结束

while ($stop_flag != 3) {

}

sleep(2);

 

sub Deal_Dns {

    Simulate_Dns("www.test.com",3600,"1.0.0.2");

}

 

 

sub Send_L2Packets {

    my @adapts = Net::Pcap::findalldevs(\$error,\%devinfo);                                                  

    my $pcap = Net::Pcap::open_live($adapts[$choice[0]-1], 1518, 1, 1, \$error);

    my $l2_packet = "ffffffffffff"."000000000002"."0806"."01010101010101010101";

    my @temp = unpack("a*", $l2_packet);

    $l2_packet = pack ("H*",$temp[0]);

    while (1) {

       Net::Pcap::sendpacket($pcap,$l2_packet);

       if ($stop_flag > 0) {

           lock($stop_flag);

           $stop_flag = $stop_flag + 1;

           last;

       }

    }

    Net::Pcap::close($pcap);

}

 

sub Simulate_Dns {

    my ($name,$ttl,$addr,$str,$dut_ip) = @_;

   

    ##准备捕获报文

    my @adapts = Net::Pcap::findalldevs(\$error,\%devinfo);                                                         

    my $pcap_rcv = Net::Pcap::open_live($adapts[$choice[0]-1], 1518, 1, 1, \$error);

    my $filter_str;

    if ($dut_ip eq "") {

       $filter_str = "udp and dst port 53 and ip src 1.0.0.1";

    }

    elsif ($dut_ip eq "none") {

       $filter_str = "udp and dst port 53";

    }

    Net::Pcap::compile($pcap_rcv, \$filter, $filter_str, 1, '');

    Net::Pcap::setfilter($pcap_rcv, $filter);

   

    Print_Step_Dev_Config ("$devinfo{$adapts[$choice[0]-1]}", "1", "Nic_Info");

    Print_Step_Dev_Config ("$filter_str", "1", "Filter");

    Print_Step_Dev_Config ("5秒\n", "1", "Time");

    Print_Step_Config ($desc, "1", "1");

   

    #需要改变的值

    my $dst_mac;

    my $src_mac;

    my $dst_port;

    my $dns_id;

    my $flag = 1;

   

    my $fact_str;

          

    while(1) {

       if ($stop_flag > 0) {

           lock($stop_flag);

           $stop_flag = $stop_flag + 1;

           last;

       }

       $pkt = Net::Pcap::next($pcap_rcv, \%hdr);

       if ($pkt ne '') {

           $eth = &Ethernet_Decode($pkt);

           $dst_mac = $eth->{src_mac};

           $src_mac = $eth->{dest_mac};

          

           $ip = &Ip_Decode($eth->{data});

           $src_ip = $ip->{dst_ip};

           $dst_ip = $ip->{src_ip};

          

           $udp = &Udp_Decode($ip->{data});

           $dst_port = $udp->{src_port};

          

           $dns = &Dns_Request_Decode($udp->{data});

           $dns_id=$dns->{Transaction_id};

          

           Print_Step_Measured_Result("网卡收到dut发出的请求域名$dns->{Query1_Name}的ip地址的dns报文\n",4,1);

          

           #构造dns响应报文

           my $response_dns = Dns_Response_Encode($dns_id,$dns->{Query1_Name},$ttl,$addr);          

           my $response_udp = Udp_Encode($src_ip,$dst_ip,"53",$dst_port,$response_dns);

           my $response_ip = Ip_Encode("17",$src_ip,$dst_ip,$response_udp);

           my $packet = $dst_mac.$src_mac."0800".$response_ip;                            

          

           Print_Step_Dev_Config ("网卡1发送的dns响应报文:\n$packet\n", "1", "Packets");

           my @temp = unpack("a*", $packet);

           $packet = pack ("H*",$temp[0]);

           Net::Pcap::sendpacket($pcap_rcv,$packet);

       }

    }

    Net::Pcap::close($pcap_rcv);

}