Compiler engineer skill tree

My new article on 81k.today: Compiler engineer skill tree , enjoy!

Perl undefined array / hash

要把  array 和 hash 清掉一樣有兩種作法

@array = ();

%hash = ();

undef @array;

undef %hash;
簡單的名詞解釋：

An array is initialized or not ->

    call scalar() to check the number of elements or call defined()

    if scalar() return false (the number of elements) is 0, then the array is uninitialized.

但是以下是錯誤示範

This would fill the array with one element at index zero with a value of undefined. 

equal to $array[0] = undef;

my @array = undef;     # WRONG!!!!

Round floating points in Perl

四捨五入是很常見的問題

 Perl 中有兩種簡單的方法可以達到：

一種是加上 0.5 後取 int() (positive numbers)

另一種是 sprintf 用 %.0f 控制

不過浮點數本身便有其限制，預設的浮點數在高精度需求的運算是無意義的

底下的範例可以看到，當要求很高的精度時，會有誤差需小心

use 5.016;
say int(9.9+0.5);                            # 10
say int(9.50000000+0.5);                     # 10
say int(9.49999999+0.5);                     # 9
say int(9.49999999999999+0.5);               # 9
say int(9.49999999999999999999+0.5);         # 9?
 
say "-"x20;
 
say sprintf("%0.f", 9.9);                    # 10
say sprintf("%0.f", 9.50000000);             # 10
say sprintf("%0.f", 9.49999999);             # 9
say sprintf("%0.f", 9.499999999999999);      # 9
say sprintf("%0.f", 9.49999999999999999999); # 9?

=output
10
10
9
9
10
--------------------
10
10
9
9
10
=cut

Perl Dumpvalue

Perl 寫程式時，常遇到複雜物件的處理，尤其是從 CPAN 上面拿到的 modules 有的  doc 往往標示不清，要用時不確定物件的確實結構，不知如何下手。

除了 Data::Dumper 以外，今天看到 Dumpvalue 這個也是內建的好用物件解析工具



使用方法：

#!/usr/bin/perl
use 5.014;
 
sub show {
    require Dumpvalue;
    state $prettily = Dumpvalue->new( compactDump => 1, veryCompact => 1);
    state $ugly = Dumpvalue->new();

    say "-"x40;
    $prettily->dumpValue(\@_);
    say "-"x30;
    $ugly->dumpValue(\@_);
    say "-"x40;
}
 
my @AoA = [[1, 2, 3], [4, 5, 6], [7, 8, 9]];
my @AoH = ({1 => 2}, {2 => 3}, {3 => 4});
show(@AoA);
show(@AoH);

output：

----------------------------------------
0  ARRAY(0x9661910)
   0  0..2  1 2 3
   1  0..2  4 5 6
   2  0..2  7 8 9
------------------------------
0  ARRAY(0x9661910)
   0  ARRAY(0x9653068)
      0  1
      1  2
      2  3
   1  ARRAY(0x9653c58)
      0  4
      1  5
      2  6
   2  ARRAY(0x9653d18)
      0  7
      1  8
      2  9
----------------------------------------
----------------------------------------
0  1 => 2
1  2 => 3
2  3 => 4
------------------------------
0  HASH(0x9653c68)
   1 => 2
1  HASH(0x9661ad0)
   2 => 3
2  HASH(0x9661b10)
   3 => 4
----------------------------------------

Ref.

perldoc lol

http://perldoc.perl.org/Dumpvalue.html

qsort in Python/Perl

社窩開始了 python 練習

題目是 qsort

其實就是最簡單的想法，分兩堆然後相加



第一次寫的方法是用 filter, 不過某 apua 說要用 list comprehension 才潮，所以 XD

然後後來寫了 Perl 版


Python

q = lambda l: (q(filter(lambda x: x > l[0], l)) + [l[0]] + q(filter(lambda x: x < l[0], l)) if l else [])


q = lambda l: ((q([ x for x in l if x > l[0]]) + [l[0]] + q([ x for x in l if x < l[0]])) if l else [])


print q([3, 5, 1, 2, 4, 7, 89, 9, 10])

Perl

sub qs { @_ ? (qs(grep {$_ > $_[0]} @_), $_[0], qs(grep {$_ < $_[0]} @_)): (); }

say join(", ", qs(10, 6, 2, 6, 2, 6, 4, 1, 3));

其實這想法很 FP，以下可以看看 Haskell code XD

Haskell

qsortOneLine s = case s of{[]->[];(x:xs)->qsortOneLine [y | y<-xs, y<x] ++ x : qsortOneLine [y | y<-xs, y>=x]}

miyagawa says good luck to me

非常崇拜的日本 hacker miyagawa 親自為我期中考加油耶！！！！


潮爽的～～～

14:30 | darkx > 可惜明天無法到場，否則真的很想聽 miyagawa 的 talk
14:31 | miyagawa > darkx: hmm too bad!
14:31 | darkx > :)
14:33 | FourDollars > miyagawa: You can read Chinese! Awesome!
14:33 | miyagawa > 繁体字 is easier to read :)
14:33 | miyagawa > still often needs google translate though
14:33 | FourDollars > haha
14:34 | darkx > I have to take my midterm exam tomorrow, but still really excited about your
                talk!
14:34 | miyagawa > darkx: good luck!
14:35 | darkx > miyagawa: cpanm is an excellent tool for we Perl users, it rocks!

python nmap

Ref: http://xael.org/norman/python/python-nmap/
https://pypi.python.org/pypi/python-nmap/0.2.7


知己知彼，百戰百勝，nmap 是什麼這邊就不多作介紹了

python-nmap 是一個 nmap 的 python wrapper ，用於方便對於 namp 操作

也許今天有好多好多機器需要作測試，pyhton-nmap 這時就是我們的好工具了

高階邏輯的部份，例如決定哪些機器需要作測試、測試的 policy 、結果分析等等

這些事情可以丟給 python 解決，而不用痛苦的在  shell scripts 裡面完成這些苦工

Sample code:

#!/usr/bin/python

import nmap
nm = nmap.PortScanner()
result = []
result.append( nm.scan('127.0.0.1', ports='22-443')   )
result.append( nm.scan('127.0.0.1', arguments='-p22-443')   )
result.append( nm.scan('localhost', arguments='-sT'))
result.append( nm.scan(arguments='-p 0-1024')       )
result.append( nm.scan(arguments='-p22 -sV')        )

for r in result:
    print r
    print "=" * 50

'''                                                                              
methods:
nm.all_hosts             nm.get_nmap_last_output
nm.nmap_version          nm.scanstats nm.command_line
nm.has_host              nm.scan
nm.csv                   nm.listscan
nm.scaninfo
                                                                                 

nm.scan()
    Definition: nm.scan(self, hosts='127.0.0.1', ports=None, arguments='-sV')        
    hosts = string for hosts as nmap use it 'scanme.nmap.org' or '198.116.0-255.1-127' or '216.163.128.20/20'
    ports = string for ports as nmap use it '22,53,110,143-4564'
    arguments = string of arguments for nmap '-sU -sX -sC'


maybe need root privileges
    PortScannerError: u'You requested a scan type which requires root privileges.\nQUITTING!\n'
'''


個人認為，在 iPython 裡面用這玩意超好用的XD


同場加映 Perl 也有人作類似的 CPAN module
http://search.cpan.org/~maxschube/Nmap-Scanner-1.0/

Perl git auto commit tool

昨天做火車想到的靈感

偶而會有一個資料夾想要一直寫東西然後存檔後自動 push 到 git 上面的需求

於是寫了以下 script ，不過寫完後才發現，這樣會弄髒 commit log ，反而是不實用 lol

純練習

#!/usr/bin/perl                                                                 
                                                                                
use 5.014;                                                                      
                                                                                
my $dir = $ARGV[0] // `pwd`;                                                    
chdir $dir;                                                                     
say "start auto commit under: " . `pwd`;                                        
                                                                                
while (1) {                                                                     
    my $diff = `git diff`;                                                      
    if ($diff) {                                                                
        my $t = `date +"%F [%T]"`;                                              
        `git add .`;                                                            
        `git commit -m "auto commit @ $t"`;                                     
        `git push`;                                                             
    }                                                                           
    sleep 10;                                                                   
}

builtin http server

有時候會有需要臨時開個 http server ，傳東西或是啥得很方便




Python 有內建


[update] Python 3 這個 module 換了名字  0w0

$ python3 -m http.server 5566
$ python2 -m SimpleHTTPServer 5566


Perl 的話可以用這個 CPAN  module

$ perl -MHTTP::Server::Brick -e '$s=HTTP::Server::Brick->new(port=>5566); $s->mount("/"=>{path=>"./"}); $s->start'


Ruby 也有內建，不過也是比較醜

$ ruby -rwebrick -e'WEBrick::HTTPServer.new(:Port => 5566, :DocumentRoot => Dir.pwd).start'


php 5.4 後也有內建... 不過誰有 php54 呢(逃

$ php -S localhost:8000 -t ./

guess anonymous plurk's owner

匿名噗是噗浪近期提供的新功能

主要用意是讓大家可以趁亂告白講出內心的話

不過，猜猜噗主的真實身份其實也挺有趣的

寫了一個簡單的腳本來做這件事

其中 $p 是 plurk 的 API 物件，請參考其他機器人的 code


Usage:

給定一個 plurk link ，Ex. http://www.plurk.com/p/asdfgh

看 source code 可以拿到該噗的 plurk_id      Ex. data-pid="1094072786">

傳給這個 function 即可得到統計資料分析出可能的匿名噗擁有者

原理：紀錄該噗回應的好友交集，假若交集愈大的話愈可能是匿名噗的主人

sub guess_anon_by_pid {                                                         
    my $pid = shift;                                                            
    my %pool;                                                                   
    my @rank = ();                                                              
                                                                                
    my $response = $p->callAPI('/APP/Responses/get', plurk_id => $pid);                                                                
    for my $f_list (keys $response->{friends}) {                                
        my $fri = $p->callAPI('/APP/FriendsFans/getFriendsByOffset', user_id => $f_list, limit => 300);
        for (@$fri) {                                                           
            $pool{$_->{display_name}}++ if ($_->{display_name});                
        }                                                                       
    }                                                                           
                                                                                
    for (keys %pool) {                                                          
        push @rank, [$_, $pool{$_}];                                            
    }                                                                           
                                                                                
    @rank = sort {$b->[1] >= $a->[1]} @rank;                                    
                                                                                
    say $_->[0], " => ", $_->[1] for (@rank[0..10]);                            
}

simple RSS fetcher in Perl

寂寞考，念不下書寫點程式 Orz

把一年前 SA 作業寫過的 RSS feed fetcher 拿出來重刻一次，主要用到這兩個 CPAN modules:

https://metacpan.org/module/XML::Feed
https://metacpan.org/module/WWW::Shorten::TinyURL

可以看得出這一年來 Perl 功力的成長(?) 總之現在寫的比較乾淨了 :P

#!/usr/bin/perl -CDS

use 5.014;

use XML::Feed;
use WWW::Shorten::TinyURL;

# max articles number each feed
use constant THRESHOLD => 5;

# RSS feed urls
my @urls = (
    "http://feeds2.feedburner.com/solidot",
    "http://www.36kr.com/feed",
    "http://pansci.tw/feed",
    "http://blog.gslin.org/feed",
    "https://www.linux.com/rss/feeds.php",
    "http://www.linuxplanet.org/blogs/?feed=rss2",
    "http://perlsphere.net/atom.xml",
    "http://planet.linux.org.tw/atom.xml",
    "http://security-sh3ll.blogspot.com/feeds/posts/default",
    "http://feeds.feedburner.com/TheGeekStuff",
    "http://coolshell.cn/feed",
);

# force to print
$|++;
my $done = 0;
my @data = ();
for my $url (@urls) {
    say "fetching ..." . (sprintf "%2d", int ($done/@urls * 100)) . "%";

    # get RSS Feed via URI
    my $feed = XML::Feed->parse(URI->new($url)) or die XML::Feed->errstr;

    my $count = 0;
    for my $entry ($feed->entries) {
        push @data, [$feed->title, $entry->title, $entry->link];
        $count++;
        last if ($count >= THRESHOLD);
    }
    $done++;
}

say "done!";

for (@data) {
    say "$_->[0] | $_->[1]\n$_->[2]";
    my $short =  makeashorterlink($_->[2]);
    say $short;
    say "============================================";
}

sha-bang! running scripts on Unix machines

reference: http://en.wikipedia.org/wiki/Shebang_(Unix)

sha-bang 是 Unix 系統上面的特殊慣例，由一個 # (sharp) 和一個 ! (bang) 組成

在 script 中，這個慣例用來表示要用哪個 interpreter 來解釋 / 執行這個 script

一般用絕對路徑來表示，例如 #!/bin/sh 來呼叫外部的 Bourne shell




#!/path/to/the/interpreter [arguments]





常見例子：

#!/bin/sh
#!/bin/sh -x
#!/bin/bash
#!/bin/sed -f
#!/usr/bin/awk -f
#!/usr/bin/perl
#!/usr/bin/python
#!/usr/bin/ruby





當然也可以很空虛的...
#!/bin/cat




另外，有時候為了可攜性，會用 /usr/bin/env python 這種用法來找到該機器的 interpreter 在哪邊

然後不要傻呼呼的吃到 Permission denied. 才在哭說不知道要怎麼跑 lol

chmod +x your_script

Parallel Programming in Perl using Parallel::ForkManager

最簡單的  Perl 平行處理

使用 Parallel::ForkManager 這個 CPAN module

https://metacpan.org/module/Parallel::ForkManager

use Parallel::ForkManager;
 
$pm = new Parallel::ForkManager($MAX_PROCESSES);
 
foreach $data (@all_data) {
  # Forks and returns the pid for the child:
  my $pid = $pm->start and next;
 
   # do some work with $data in the child process ...
 
  $pm->finish; # Terminates the child process
}

寫了一個 Parallel 的 MD5 Bruteforce Cracker

#!/usr/bin/perl

use 5.012;
use warnings;

# MD5 Hash Bruteforce Kit
# original version by Iman Karim (iman.karim@smail.inf.fh-bonn-rhein-sieg.de)
# http://home.inf.fh-rhein-sieg.de/~ikarim2s/

# modified by xatier (xatierlike @gmail.com)
# Date : 10/15 2012
# This Cracker is by far not the fastest! only used to find "lost" passwords ;)
# run on my ubuntu server :P

my $ver = "02";

use Digest::MD5 qw(md5_hex);
use Time::HiRes qw(gettimeofday);
use Parallel::ForkManager;

# for parallel cracking
our $MAX_PROCESS_NUMBER = 25;

# charset
my $alpha = "";
$alpha .= "abcdefghijklmnopqrstuvwxyz" if ($ARGV[0] =~ "a");
$alpha .= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" if ($ARGV[0] =~ "A");
$alpha .= "1234567890"                 if ($ARGV[0]=~"d");
$alpha .= "~!@#\$%^&*()_+`-=[]\\{}|;':\",./<>?"  if ($ARGV[0]=~"x");


usage() if ($alpha eq "" or $ARGV[3] eq "");

if (length($ARGV[3]) != 32) {
    die "Sorry but it seems that the MD5 is not valid!\n";
};

say "Selected charset for attack =>  '$alpha'";
say "Going to Crack '$ARGV[3]'";
say "length from $ARGV[1] to $ARGV[2]...";
say "Press Enter to continue...";
my $key = <>;
system("mv key.txt key.txt.old");

# go!
for (my $t = $ARGV[1]; $t <= $ARGV[2]; $t++) {
    crack ($t);
}

sub usage {
    say<<EOF;   
    Charset can be: [aAdx]
    a = {'a','b','c',...}
    A = {'A','B','C',...}
    d = {'1','2','3',...}
    x = {'!','\"',' ',...}

    EXAMPLES:
       ./md5crack.pl ad 1 3 900150983cd24fb0d6963f7d28e17f72
            all lowercase Alphas and all digits
            length from 1 and 3 characters.
        ------------------------------
       ./md5crack.pl aA 3 3 900150983cd24fb0d6963f7d28e17f7;
            all lowercase Alphas and all uppercase Alphas;
            exactly 3 characters.
        ------------------------------
       ./md5crack.pl aAdx 1 10 900150983cd24fb0d6963f7d28e17f7;
            nearly every characte;
            length from 1 to 10 character;
EOF
    die "Quitting...\n";
}

sub crack {
    my $CharSet = shift;
    my @RawString = ();
    my @testdata = ();
    my @realbuf = ();
    my $BUFSIZ = $MAX_PROCESS_NUMBER;
    my $data_BUFSIZ = 100;
    my $data_count = 0;
    my $real_count = 0;
    push @RawString, 0 for (0 .. $CharSet - 1);

    do {
        for (my $i = 0; $i < $CharSet; $i++) {
            if ($RawString[$i] > length($alpha)-1) {
                if ($i == $CharSet-1) {
                    crack_parallel([@realbuf]);
                    say "Bruteforcing done with $CharSet Chars. No Results.";
                    return;
                }
                $RawString[$i+1]++;
                $RawString[$i] = 0;
            }
        }

        my $ret = "";
        $ret .= substr($alpha,$RawString[$_], 1) for (0 ..$CharSet-1);

        if ($data_count < $data_BUFSIZ) {
            push @testdata, $ret;
            $data_count++;
        }

        if ($data_count == $data_BUFSIZ) {
            push @realbuf, [@testdata];
            @testdata = ();
            $data_count = 0;
            $real_count++;
        }

        if ($real_count == $BUFSIZ) {
            crack_parallel([@realbuf]);
            @realbuf = ();
            $real_count = 0;
        }

        $RawString[0]++;

    } while ($RawString[$CharSet-1] < length($alpha));
}


sub crack_parallel {
    my $realbuf_ref = shift;

    my $pm = new Parallel::ForkManager($MAX_PROCESS_NUMBER);

    $pm->run_on_finish (
        sub {
            my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $ref) = @_;
            if (defined $ref) {
                say "$ref->[0] ==> $ref->[1]";
                open F, ">", "key.txt";
                say F "$ref->[0] ==> $ref->[1]";
                close F;
                $@ = "";   # shut up, error message!
                die "\n**** Password Cracked! ";
            }
        }
    );

    for my $r (@$realbuf_ref) {
        # paralleize the cracking md5s
        $pm->start and next;
        for my $text (@$r) {
            my $hash = md5_hex($text);
            say "$ARGV[3] != $hash ($text)";
            if ($ARGV[3] eq $hash) {
                $pm->finish(0, [$text, $hash]);
            }
        }
        $pm->finish(0);
    }
    $pm->wait_all_children;
}

cpanp and cpanm note

CPAN

$ sudo cpanp

s reconfigure

7 Select mirrors

No

Mirror => Asia => Taiwan


Quit

Save and exit




# req

s conf prereqs 1
s save




# skip test
s conf skiptest 1
s save




s selfupdate all

i Bundle::CPAN




CPANM

https://github.com/miyagawa/cpanminus/

$ wget http://xrl.us/cpanm

$ chmod +x cpanm

$ mv ./cpanm /usr/bin

$ cpanm --self-upgrade --sudo

$ sudo cpanm Parallel::ForkManager

emesene 2.12.3 password hacking

閒來無事逛了一下 exploit-db （謎：怎麼這麼閒）

看到這篇頗有趣的

http://www.exploit-db.com/exploits/19517/

把 emesene （Linux 上的一個 MSN client）user password 弄出來的小 Perl script

就想說也來檢查一下我的 emesene

一看之下才發現真歡樂，

emesene 的 ~/.config/emeseme2/config 裏面 passwd 只是簡單的 base64 XD

而且他是 -rw-rw-r--

所以只要

cat ~/.config/emesene2/config | grep @ | head -n 1 | awk '{print $2}' | sed s/\"//g | base64 -d

Larry Wall's Quotes

from brainyquote.com


Doing linear scans over an associative array is like trying to club someone to death with a loaded Uzi.
Larry Wall


For me, writing is a love-hate relationship.
Larry Wall


Hubris itself will not let you be an artist.
Larry Wall


I am not a sort of person who wants to run a company.
Larry Wall


I still drive my 1977 Honda Accord. The paint is almost all worn off. It's still running.
Larry Wall


I take time to watch anime. I don't know whether I'm allowed to, but I do it anyway.
Larry Wall



I talked about becoming stupid, but I've always been stupid. Fortunately I've been just smart enough to realize that I'm stupid.
Larry Wall


I think computer science, by and large, is still stuck in the Modern age.
Larry Wall


I think operating systems work best if they're free and open. Particular applications are more likely to be proprietary.
Larry Wall


I think software patents are a bad idea. Many patents are given for trivial inventions.
Larry Wall


I think the way IBM has embraced the open source philosophy has been quite astonishing, but gratifying. I hope they'll do very well with it.
Larry Wall


I want people to use Perl. I want to be a positive ingredient of the world and make my American history. So, whatever it takes to give away my software and get it used, that's great.
Larry Wall



I'm just paid to do whatever I want to do. Some of the time it's development, and some of the time it's just goofing off.
Larry Wall


I'm never satisfied because I've been always interested in too many things and I always want to do everything at once.
Larry Wall


If any ideology is so serious that you can't have fun while you're doing it, it's probably too serious.
Larry Wall


If you're a large corporation, you can afford to pay the money to register patents, but if you're an individual like me, you can't.
Larry Wall


Many days I don't write any code at all, and some days I spend all day writing code.
Larry Wall


One of the very basic ideas of Post-Modernism is rejection of arbitrary power structures. Different people are sensitive to different kinds of power structures.
Larry Wall


Perl was designed to work more like a natural language. It's a little more complicated but there are more shortcuts, and once you learned the language, it's more expressive.
Larry Wall


Post-Modernism was a reaction against Modernism. It came quite early to music and literature, and a little later to architecture. And I think it's still coming to computer science.
Larry Wall

Programmers can be lazy.
Larry Wall


Real programmers can write assembly code in any language.
Larry Wall


Some of modern engineering is necessary to good art. But I think of myself is a cultural artist.
Larry Wall


Somebody out there is going to do something that's far more surprising than anything that I would do. I was surprised by the whole web thing in the first place.
Larry Wall


The Harvard Law states: Under controlled conditions of light, temperature, humidity, and nutrition, the organism will do as it damn well pleases.
Larry Wall


The problems that I really like to solve are our cultural problems.
Larry Wall



The three chief virtues of a programmer are: Laziness, Impatience and Hubris.
Larry Wall


The world has become a larger place. The universe has been expanding, and Perl's been expanding along with the universe.
Larry Wall


There is no schedule. We are all volunteers, so we get it done when we get it done. Perl 5 still works fine, and we plan to take the right amount of time on Perl 6.
Larry Wall


To be a good artist, you have to serve the work of art and allow it to be what it is supposed to be.
Larry Wall


We all agree on the necessity of compromise. We just can't agree on when it's necessary to compromise.
Larry Wall


We are so Post-Modern that we don't realize how Post-Modern we are anymore.
Larry Wall



When I announced the development of Perl 6, I said it was going to be a community design. I designed Perl, myself. It's limited by my own brain power. So I wanted Perl 6 to be a community design.
Larry Wall


Younger hackers are hard to classify. They're probably just as diverse as the old hackers are. We're all over the map.
Larry Wall

Larry Wall's video

來聽聽神的訪問

Perldoc in Vim

昨天上 NA 時用 vim 寫筆記

寫到一半不小心按到 CapsLock 鍵，然後我按下 k 時竟然彈出了神奇的 man ！！！

:help K 看一下，竟然有有趣的東西XDD

K                       Run a program to lookup the keyword under the           
                        cursor.  The name of the program is given with the      
                        'keywordprg' (kp) option (default is "man").  The       
                        keyword is formed of letters, numbers and the           
                        characters in 'iskeyword'.  The keyword under or        
                        right of the cursor is used.  The same can be done      
                        with the command >                                      
                                :!{program} {keyword}                           
<                       There is an example of a program to use in the tools    
                        directory of Vim.  It is called 'ref' and does a        
                        simple spelling check.                                  
                        Special cases:                                          
                        - If 'keywordprg' is empty, the ":help" command is      
                          used.  It's a good idea to include more characters    
                          in 'iskeyword' then, to be able to find more help.    
                        - When 'keywordprg' is equal to "man", a count before   
                          "K" is inserted after the "man" command and before    
                          the keyword.  For example, using "2K" while the       
                          cursor is on "mkdir", results in: >                   
                                !man 2 mkdir                                    
<                       - When 'keywordprg' is equal to "man -s", a count       
                          before "K" is inserted after the "-s".  If there is   
                          no count, the "-s" is removed.                        
                        {not in Vi}

K 會對著現在游標的 word 去找 man ，這個功能寫 Shell script  應該很好用XDD

然後這個功能給我了一個啟發，喜歡寫 Perl 的我，何不把這功能跟 perldoc 結合起來呢？

於是我在我的 vimrc 底下寫了這個

au FileType perl nmap K :!perldoc -f <cword><CR>

用 autocmd 來幫我完成從 perldoc 找到現在的 cword 去匹配裏面的說明

原本很開心的以為這是我自己原創的 hack

後來 google 了一下  perlmonks.org  上早就有人問過了XD

perlbuzz.com 的文章跟我幾乎一模一樣 XDDD

他還去找了非內建函式的 perldoc

於是我把我的版本修改成這樣 (多一個 <CR> 讓離開 less 時不用多按一下 Enter)

au FileType perl nmap K :!perldoc <cword> <bar><bar> perldoc -f <cword><CR><CR>

不過其實很多 vim plugins 就已經有類似的功能了

http://vim.sourceforge.net/scripts/script.php?script_id=1913
http://vim.sourceforge.net/scripts/script.php?script_id=1217
http://www.vim.org/scripts/script.php?script_id=209

tcpdump in Perl

半夜睡不著不知道要幹嘛...

爬起來摸 CPAN 上一些簡單的 packet sniffer in Perl 的 module

玩著玩著就寫(ㄔㄠ)出一個了

基本上還是用 pcap(3) (Packet Capture library)

不過 Perl 有 NetPacket module 把他抽象化了

http://search.cpan.org/search?query=NetPacket

概念上很簡單，就一層一層把 header 拆掉 (encapsulation ?)

把 link layer => IP layer => transport layer 依序拆開

可能有念過 networking 會比較有概念 :P

最後用 Data::HexDumper 把 binary 拆成 hex 跟 ascii 比較好閱讀

http://search.cpan.org/~dcantrell/Data-Hexdumper-3.00/lib/Data/Hexdumper.pm

#!/usr/bin/perl                                                                 
                                                                                
use 5.012;                                                                      
                                                                                
use Net::PcapUtils;                                                             
use NetPacket::Ethernet qw(:strip);                                             
use NetPacket::IP qw(IP_PROTO_TCP);                                             
use NetPacket::TCP;                                                             
use Data::HexDump;                                                              
                                                                                
                                                                                
sub process_pkt {                                                               
    my ($user_data,$header, $packet) = @_;                                      
    # decode the Ethernet and IP headers                                        
    my $ip = NetPacket::IP->decode(eth_strip($packet));                         
                                                                                
    if ($ip->{proto} == IP_PROTO_TCP) {                                         
        # decode TCP headers                                                    
        my $tcp = NetPacket::TCP->decode($ip);                                  
        # now we get TCP packet XD                                              
        say "\n$ip->{src_ip}($tcp->{src_port}) -> $ip->{dest_ip}($tcp->{dest_port})";
        say HexDump $ip->{data};                                                
    }                                                                           
}                                                                               
                                                                                
my $filter = join(" ", @ARGV);                                                  
say $filter;                                                                    
Net::PcapUtils::loop(\&process_pkt, SNAPLEN=> 65536, FILTER => $filter);

Usage


    sudo ./pcap.pl


    sudo ./pcap.pl host 140.113   # 支援簡單的 filter

Perl: while with no conditional

stackoverflow 上面有人問了有趣的問題

According to the doc, the while statement executes the block as long as the expression
 is true. I wonder why it becomes an infinite loop with an empty expression

while () { # infinite loop
 ...
}

Is it just inaccuracy in the doc?

Perl: while with no conditional

我們可以用

perl -MO=Deparse [Perl program]

B::Deparse module  - Perl compiler backend to produce perl code

來分析語法上的正確性


B::Deparse is a backend module for the Perl compiler that generates perl source code, based on the internal compiled structure that perl itself creates after parsing a program. The output of B::Deparse won't be exactly the same as the original source, since perl doesn't keep track of comments or whitespace, and there isn't a one-to-one correspondence between perl's syntactical constructions and their compiled form, but it will often be close. When you use the -p option, the output also includes parentheses even when they are not required by precedence, which can make it easy to see if perl is parsing your expressions the way you intended.
While B::Deparse goes to some lengths to try to figure out what your original program was doing, some parts of the language can still trip it up; it still fails even on some parts of Perl's own test suite. If you encounter a failure other than the most common ones described in the BUGS section below, you can help contribute to B::Deparse's ongoing development by submitting a bug report with a small example.





以下幾個分析 ...

$ perl -MO=Deparse -e 'while (){}'
while (1) {
    ();
}
-e syntax OK

$ perl -MO=Deparse -e 'for (){}'
syntax error at -e line 1, near "()"
-e had compilation errors.

$ perl -MO=Deparse -e 'for (()){}'
foreach $_ (()) {
    ();
}
-e syntax OK

$ perl -MO=Deparse -e 'for ((<>)){}'
foreach $_ (<ARGV>) {
    ();
}
-e syntax OK

$ perl -MO=Deparse -e 'for(;;){}'
while (1) {
    ();
}
-e syntax OK

最後一個例子是 Brain D Foy 給出的