gyn

因为是刚开始看  haskell  所以很多概念不是很清楚，比如何时用  do  、“  <-  ”和  let  。  Exerceise3.10  算是做出来，但是肯定不是一个好办法。希望给我改改吧，顺便解答一下我的疑问。不得不说的是编译信息相当地没有用啊，这真是太遗憾了。

module Main

   where

   

import IO

 

main = do

   list <- askForNumber

   let 

      sAdd = show (foldl (+) 0 list)

      sMul = show (foldl (*) 1 list)

   putStrLn ("The sum is " ++ sAdd)

   putStrLn ("The production is " ++ sMul)

   putFactorial list

          

askForNumber = do

   putStrLn "Give me a number (or 0 to top):"

   sNum <- getLine

   let num = read sNum

   if num == 0

      then return []

      else do

          rest <- askForNumber

          return (num : rest)

          

putFactorial [] = do

   putStr ""

   

putFactorial (x : rest) = do

   let fact = factorial x

   putStrLn ((show x) ++ " factorial is " ++ (show fact))

   putFactorial(rest)

 

factorial 1 = 1

factorial x = x * factorial (x-1)

因为在用  Perl-Tk  或者  Socket  时，经常会需要监视某些打开的句柄而不至于阻塞主循环， 对于这些 win32  下的 Perl 表现远不如 Linux 下来得得心应手，但这时候我基本没有什么办法。这和 windows 的底层 select 实现有关，而 Perl 恰恰是调用它的，但我一直认为肯定有别的替代办法，因为 Tcl/Tk 的 fileevent 就表现得很好。

下面是一个例子，用来显示  ping  的结果。这里有两个组件，一个是按钮，用来开始和停止  ping  ；另一个是  text  用来显示  ping  的结果。分别用  Perl  和  Tcl/Tk  代码来实现，看看他们有什么不同。

use Tk;

 

$count = 4;

$host = '127.0.01';

 

$mw = MainWindow->new;

 

$bt = $mw->Button(-text => 'Clink to start ping', -command => \&RunPing);

$bt->pack(-fill => 'x');

 

$tx = $mw->Text(-width => 50, -height => 30);

$tx->pack;

 

MainLoop;

 

sub RunPing {

   open $fd, "ping -n $count $host|";

   $mw->fileevent($fd, 'readable' => sub {

      sysread $fd, $buf, 30;

      $tx->insert('end', $buf);

      });

   $bt->configure(-text => 'close', -command => \&ClosePing);

}

 

sub ClosePing {

   close $fd;

   undef $fd;

   $bt->configure(-text => 'Clink to start ping', -command => \&RunPing);

}

运行的结果很让人失望，在  readable  的事件中加入  print  后而已更清楚地看到，事实上  readable  事件是没有被触发过的。这里的  fileevent  是  Tk  中处理事件触发的函数，它为句柄的两个状态（  readable  ，  writable  ）设定触发函数，其本质上使用了系统的  select  或者  poll  ，换句话说即便是用  Perl  的  select  或者  IO::Seelct  也是于事无补。文档里的原话佐证了这点“  A file is considered to be readable on same basis as the system's select() (or poll()).  ”。

所以可以这么讲，  win32  下的  Perl  是不大适合处理事件响应的，因而也就很难处理好处理网络相关或者界面需要运行后台长时间操作的情况。接下来换作是使用  Tcl/Tk  来实现这一功能，值得一提的是在  Perl  下  50  宽度的  button  和  text  是不等长的，所以索性在  pack  里用  fill  自动拓宽了，而在  Tcl/Tk  中没有这个问题。

package require Tk

 

set pingcount 4

set host {127.0.0.1}

 

button .btn -text {Clink to start ping} -command "RunPing $host $pingcount" -width 50

text .text -width 50 -height 30

pack .btn .text

 

proc RunPing {host count} {

   set fd [open "|ping -n $count $host"]

   ;#fconfigure $fd -blocking 0

   fileevent $fd readable "onPingRead $fd $count $host"

   .btn configure -text "close" -command "closeFd $fd $count $host"

}

 

proc onPingRead {fd count host} {

   if {[eof $fd]} {

      closeFd $fd $count $host

   } else {

      set buf [gets $fd]

      .text insert {end} "$buf\n"

   }

}

 

proc closeFd {fd count host} {

   close $fd

   .btn configure -text {Clink to start ping} -command "RunPing $host $count"

}

为了使用同样条件的管道，屏蔽了设置非阻塞的代码行，但这么作   因为系统不得不等待管道中的进程运行结束，所以   也使得  close  没有起到应有的作用。

运行的结果很令人满意，  test  没有被阻塞，在显示  ping  结果的同时，依然可以在  text  中执行输入，而且  button  也可以被顺利按下。这么看来  Tcl/Tk  比之  Perl  在  win32  下，显然在事件处理上占有优势，而且这个占优的方面是极其重要的。

不得不说的是   google   上搜索出来的竟然都是《   perl   在   win32   平台上直接操作打印机》，这是非常令人抱歉的文章。很显然是初学者写的，如果连这个都不知道，我还真是佩服他怎么学   perl   的了，这不是单指   win32   下的打印办法，哪里都一样。但是这太简陋了，不是我想要的。  

当然了，在   avtivePerl   中你可以使用   ppm   下载   Printer   来打印，但是当你看见那可怜的文档后，也许会打消这个念头，或者打印一些   text   是再好不过了。或者使用   cpan   安装   Win32::Word::Writer   来打印，我想它是非常好的，但前提是你能装的上它，而我在   win32   下装不上。  

这个问题事实上困扰了我很久，因为很多时候你写的   tk   界面脚本，需要将分析的数据打印出来，如果不将这个功能集成进脚本，便不得不求助于其他的工具，比方说先生成一个文档，然后用   openoffice   或者其他打开它，最后在其中实现打印，这非常麻烦，而且也不容易让使用者接受。  

既然没有特别好的针对性工具，我变依照上面的流程模拟这个过程，但这一切都是在内存中实现的，因此对于用户，不会知道里面的实现细节，这样很好。首先我用   Win32::OLE   打开一个文档，要保证它是不被   visiable   。之后将需要打印的文档按照其中的格式，打入到这个文档中。最后打印出来。不过可能是   OLE   的   bug   ，这样做会在内存中保留一个到该文档的句柄，在关机的时候不有提示出错，而且如果在程序中直接使用   close   的话，会弹出对话框询问是否保存，这就做不到隔离使用者的效果了。所以，使用   saveas   将文档存到   disk   里，这算是一个无奈的妥协。下面是我在集群文档编辑系统中的用于打印的一个函数：  

sub file_print {

    my  $cur_style   =  ' a ' ;

    my  $word        =

      Win32 :: OLE -> new( ' Word.Application ' ,  ' Quit ' ) or die $ ! ;

    $word -> { ' Visible ' } =  0 ;

    my  $document    =  $word -> Documents -> Add;

     my  $selection   =  $word -> Selection;

    my  $style       =  $document -> Styles -> Add( $cur_style );

    my  $style_font  =  $style -> {Font};

    $style_font -> {Name}                         =  $family ;

    $style_font -> {Size}                          =  $size ;

    $style_font -> {Bold}                         =  $weight ;

    $style_font -> {Italic}                       =  $slant eq ' italic '  ?  1  :  0 ;

    $style_font -> {Underline}                    =  $underline ;

    $document -> ActiveWindow -> Selection -> {Style} =  $cur_style ;

    $selection -> TypeText( $textundo -> get( ' 1.0 ' ,  ' end ' ) );

    $word -> ActiveDocument -> PrintOut;

    $document -> SaveAs( ' printout.doc ' );

    $document -> Close ;

    $word -> Quit;

}

因为   tk   下的   font   和   word   中的有些不兼容，所以做了一些变换，比如说对于   slant   ，   tk   是用   ‘italic’   和   ‘roman’   的，相对于   word   就是布尔值了。

这里讲的两个都是非标准组件，所以一般都是建立在标准的   pTk   组件之上的，由纯   perl   代码写成的，因此也便于修改。  

第一个是   ToolBar   ，就是文件浏览器中的在菜单栏之下的，一般叫工具栏。   pTk   中的   ToolBar   标准支持   Button   ，   Label   ，   LabEntry   ，   OptionMenu   和自带的一个   separator   （这个还是很有用的）。如果要加入其他的组件，比如   BrowseEntry   ，   pack   之后会被   ToolBar   放到工具栏的第二行上，很不方便。现在我们来看看   ToolBar.pm   ，里面到底是怎么处理标准支持的。搜索到   ToolLabel   的   sub   ，里面的代码如下：  

sub ToolLabel {

   my $self = shift;

   my $l = $self->{CONTAINER}->Label(@_);

   push @{$self->{WIDGETS}} => $l;

   $self->_packWidget($l);

   return $l;

}

对比其他的几个   sub   ，我可以很肯定，只要将第四行中的   Label   改成   BrowseEntry   就可以了，这里缺少的一行是关于   tip   的，对于   BrowseEntry   来说，没有必要。  

第二个是   DateEntry   。就是一个日期选择器，很多时候我们会用到它。我再使用的时候发现了一个问题，就是在显示月份的地方，出现了乱码，打开   DateEntry.pm   一看，找到如下一段：  

my $monthlabel = (defined &strftime

         ? strftime($w->cget('-headingfmt'),0,0,0,1,

                $w->{_month}-1,$w->{_year}-1900)

         : $w->{_month} . "/" . $w->{_year}

        );

显然，它是用了   strftime   这个函数，去除选择，直接用冒号后的形式即可。  

还有，如何让在日期控件中的日期按钮被按下的时候响应一个事件。作为一般的控件这是一个必要的功能，但是在   DateEntry   中却没有，查看了源代码，原来是回调了用于更新标签和关闭的   selectDay   函数。这么作是很不负责任的，如果不修改源代码，我们就不得不在此控件旁添加一个按钮用于触发事件，这样一来不美观，而来更重要的是不符合一般的使用习惯。为此需要在   ConfigSpec   中添加一个   -btncommand   的标签，并在   selectDay   中回调。  

引入文件结构保护的原因

随着越来越多的工作、数据被迁移到服务器及存储上，对于这些作为业务基础的软硬件的安全性和可靠性，我们需要提高关注度，并在尽可能的范围内提高这种可靠性，以保障工作的平稳顺利开展。  

针 对不同的内容，我们可以采取不同的安全保障策略。比方说，对于服务器的灾难恢复，比较方便而合适的办法是用双机热备，备机通过监视主机运行状况，实现尽可 能快地恢复服务。而对于资料的存储，我们多是会选择一些实践证明了的比较可靠的数据备份和恢复方法，这些方法多是基于某种特定的数据库的，或者是数据库自 身提供的。  

以上两点内容是大多数管理者想得到并且可以做得不错的，我们常常会忽略一点是，作为提供某种服务的程序本身的安全性。打个比方说，提供   web   服务的   apache   ， 其配置和一些附属的文件可能遭到破坏，而且即便是有操作系统锁级的保护，进程也可能被恶意停止，进而破坏文件。拓展开来讲，任何以文件或者文件树形式存储 的数据的安全性，一向被忽略。其结果是，我们不得不重新安装服务并配置参数，这不是一项轻松的工作，尤其是对于一些复杂的程序而言。  

虽然针对不同服务的保护各不相同，但一般都需要涉及到对于该服务的文件结构保护，在此基础上在做一些进程的恢复工作等。  

文件结构保护系统的架构

除了必要的防杀毒软件之外，还需要一些更一般的保护手段，因为病毒库的更新总是有滞后性的。这些手段包括建立文件结构信息备份、实时监控和文件恢复等。  

首 先，在确定系统一切正常的前提下，对于需要进行保护的文件结构，我们需要采集能唯一标识该结构的必要信息，至少包括一个描述文件结构的数据结构和在其中每 一个文件的唯一标记。就前者而言，可以是一个多叉树或者向量，这个根据不同的工具的特性具体而定；文件唯一标记可以通过计算整个文件的   md5   码来得到，这也是现阶段在网络上发布文件尤其是大型文件时，保证文件完整性的一个通用做法，比如说   ubuntu   的发布。除了多叉树或向量数据结构需要驻留本地之外，其他的必要信息连同文件结构中所有有效文件将存储到一个可以保证安全的位置，这个位置一般是一台被隔离的服务器，通过有限的端口与存在受保护文件结构的服务器相连接，也就是监控端。  

完 成了文件结构的备份之后，将建立服务器之间的监控关系。因为文件遍历的本地性特点，所以主逻辑即数据结构与文件结构之间的比较需要在被监控段实现。根据比 较之后的结果，包括被恶意添加或删除的文件，做出是否恢复或删除的决定。而具体到每一个文件的完整性检测，则需要被监测端将当前次文件遍历中得到的   md5   码，发送至监测端进行比较。因此，从最终的实现来看，服务器两端之间的关系并不能完全用监控来描述，事实上被监控端将负责起遍历文件结构的工作，而监控端将主要负责   md5   码比较和文件恢复的功能。  

最后在监控端，通过一定的途径连接监控程序和备份信息，实现文件按顺序有效地回传，这样就基本上形成了一个文件结构保护系统的框架。  

需要注意的一些细节

文件结构信息的采集需要在系统建立之初就准备就绪，然后通过人工拷贝的方法移植到监控端。这个采集过程相对来说比较简单，只需要一次文件结构的遍历就可以实现。监控端的信息存储可以考虑使用数据库，而在存储文件的时候，根据具体的回传特点可以直接存储在文件系统之下或者以   blob   的形式存入数据库。  

相比于略显简单的初始化，保护系统实现的关键环节在于文件结构与数据结构的比较以及如何准确地回传文件。  

首 先数据结构的建立需要在保护系统启动的初始化环节完成，之后它将作为整个系统运行的基础，循环地将文件结构与它进行对比。而该对比过程可以通过两种方法来 实现。第一：两次遍历，即数据结构和文件结构遍历。这么做的好处是实现难度不大，尤其是在文件结构遍历部分，可以任意选择深度或广度遍历。但是针对遍历中 每个节点遇到的文件或文件夹，不得不查询一次数据结构，对于设计不佳的数据结构，这么做的结果可能又是一次遍历，这就增加了运行的时长。第二：一次遍历， 即在数据结构和文件结构同时以一种相对协调的步调向下遍历。这里所说的向下即是说，需要在完成本层次遍历的基础上才能继续下一个层次，也就是层次优先遍 历。这样的做法需要在设计上保证数据结构与文件结构具有类似性，而对于层次的控制也完全依靠人工逻辑完成，但在运行上将获得比前一种方法快一个数量级以上 的优势。  

在文件回传方面，由于存在很大可能性是需要恢复的一个文件列表，所以应准确控制其中每一个文件恢复的启动与截至。可以采用架设   ftp   服务器的方法，在传输单文件时阻塞本地剩余传输队列中的文件。在这里采用了这种模式，但未直接使用   ftp   ，而是采用了一种简化的模拟方式：被监控端维护一个文件处理队列，通过阻塞的方式和先进先出的顺序来处理   文件句柄   ；建立了两个   socket   连接，其中之一在监控端接受被监控端发出的指令并启动数据传输，另一个在被监控端接受来自监控端的文件传输完成信号并关闭本地文件句柄，然后通知启动下一个文件传输。  

Perl  实现的几点建议

一：   对于这种通过网络来连接的服务，整体的框架可以考虑使用   poe   ，这将极大地减少底层代码的维护量，而将精力主要集中到业务逻辑的实现上来。尤其是在合理利用   component   的情况下，一段几十行的   socket   代码可能会被压缩为短短几行。更为重要的是，   poe   在单线程内实现了多任务模式，虽然依旧会阻塞在长任务执行过程中，但这方便各个任务之间信息的传递和资源的共享。对于未来其他模块功能的增加，也   提供了   一个可扩展的基础。比如，需要为客户端提供一个可视的操作界面，只需引入   Tk   ，   poe   会在变量表中自动添加根元素   $poe_main_window   。  

二：   由于文件结构信息的量一般不是很大，因此在事先未安装其他数据库的情况下，信息的存储可以考虑使用轻量级的   sqlite   。它没有守护进程，一般以嵌入的形式   服务   于各个   任务   中。  

三：   体现文件结构逻辑的数据结构，可以使用   hash   表来实现，在这里   hash   表起得是多叉树的作用。打个比方，针对绝对路径  

d:\sources\perl\frs\md5_check.pl

其数据结构将是   :

$base->{d}->{sources}->{perl}->{frs}->{md5_check.pl} = ’f’

也就是说任意的目录是一个   hash   引用，而最终的文件节点是一个内容为“   f   ”的   text   变量。那么在遍历时，就可以通过   ref   节点类型来判断是目录还是文件。  

四：   在处理关闭文件传输的指令时，可以考虑使用   ikc   来远程调用本地指令，这实际上是简化了由远程发指令、本地翻译再到本地指令执行这一连串的过程，用在这里也方便未来丰富远程指令。  

原文在http://www.perlmonks.org/index.pl?node_id=170648里，代码抄了一遍。  

use Net::Pcap;  

use NetPacket::Ethernet;  

use NetPacket::IP;  

use NetPacket::TCP;  

use strict;  

my $err;  

#  Use network device passed in program argments or if no  

#  argument is passed, determine an appropriate network  

#  device fo packet sniffering using the  

#  Net::Pcap::lookupdev method  

my $dev = $ARGV[0];  

unless (defined $dev) {  

    my @devs = Net::Pcap::findalldevs(\$err);  

    if (defined $err) { die 'Unable to determine network device for monitoring - ', $err; }  

    if (length(@devs) == 2) { $dev = $devs[1]; }  

    else { $dev = $devs[0]; }  

    }  

      

#  Look up network address information about network  

#  device using Net::Pcap::lookupnet - This also acts as a  

#  check on bogus network device argument that may be  

#  passed to the progeam as an argument  

my ($adress, $netmask);  

if (Net::Pcap::lookupnet($dev, \$address, \$netmask, \$err)) {  

    die 'Unable to look up device information for ', $dev, ' - ', $err;  

    }  

#  Create packet capture object on device  

my $object;  

$object = Net::Pcap::open_live($dev, 1500, 0, 0, \$err);  

unless (defined $object) {  

    die 'Unable to create packet capture on device ', $dev, ' - ', $err;  

    }  

      

#  Compile and set packet filter for packet capture  

#  object - For the capture of TCP packes with the SYN  

#  header falg set directed at the external interface of  

#  the local host, the packet filter of '(dst ip) && (tcp[13] & 2 != 0)'  

#  is used where IP is the IP address of  

#  the external interface of the machine,  For  

#  illustrative purposes, the IP address of 127.0.0.1 is used in thsis example.  

my $filter;  

Net::Pcap::compile(  

    $object,  

    \$filter,  

    '(dst 127.0.0.1) && (tcp[13] & 2 != 0)',  

    0,  

    $netmask  

) && die "Unable to compile packet capture filter";  

Net::Pcap::setfilter($object, $filter) &&  

    die 'Unable to set packet capture filter';  

      

#  Set callback function and initialate packet capture loop  

Net::Pcap::loop($object, -1, \&syn_packets, '') ||  

    die 'Unable to perform packet capture';  

      

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

sub syn_packets {  

    my ($user_data, $header, $packet) = @_;  

      

    #  Strip ethernet encapsulation of captures packet  

      

    my $ether_data = NetPacket::Ethernet::strip($packet);  

      

    #  Decode contents of TCP/IP packet contained within  

    #  captured ethernet packet  

      

    my $ip = NetPacket::IP->decode($ether_data);  

    my $tcp = NetPacket::TCP->decode($ip->{'data'});  

      

    #  Print all out where its coming from and where its going to!  

      

    print  

        $ip->{'src_ip'}, ":", $tcp->{'src_port'}, " -> ",  

        $ip->{'dest_ip'}, ":", $tcp->{'dest_port'}, "\n";  

    }  

在 django中建立 登出用户功能的时候，除了建立以下程序并在urls中增加映射之外，还需要在registration中建立一个叫做 “logged_out.html” 的文件，这是无可避免的，虽然被HttpResponseRedirect('/')重定向到了主页，但至少也需要存在一个空文件。

from django.contrib.auth.views import logout 

from django.http import HttpResponseRedirect 

def page_logout(request):    

    logout(request)    

    return HttpResponseRedirect('/')