#!/usr/bin/perl

# getnode.pl
#
# Small utility to download (and optionally execute)
# the code from a node on http://www.perlmonks.org
# Downloads what is under the link "d/l code", which
# may or may not be possible to execute. :) I use this
# program mainly for obfus and sometimes poetry, since
# I got tired of copy/paste, save to file, execute by 
# hand. Now I just type 'perl getnode.pl node-id (or name)' 
# to see what happens. It may be potentially dangerous to
# just execute anything like this, so use with caution.
# I will not be held responsible for any damage this may
# cause - which will hopefully be none. :) Or set default
# to just d/l the code for examination. See comments and 
# 'perl getopt -h' for more instructions.
#
# Suggestions for improvement etc. are welcome. :)
#
# Written by Kristoffer Lundén 2002 <kung.stoffe@home.se>
# Program can be used, changed etc under the same terms as
# perl itself.
#

# No strict or warnings, because it may interfere
# with evaled scripts, if they can't have it. Use a
# downloaded copy to execute (-m, -M, -f, -F) if a
# program has for instance '-w' that should be run.

use Getopt::Std;
use LWP::Simple;

# Predeclare command line variables:
use vars qw($opt_h $opt_m $opt_M $opt_f $opt_F $opt_p $opt_q $opt_d);

# Get command line options:
getopts('dqhpmMf:F:');


# Defaults:

# Directory to save fetched code in:
my $directory = '/tmp/';

$opt_p = 1; # -p switch is on by default.
            # Comment out if undesirable.

# You can set any of the above variables
# to appropriate values to alter the default
# behaviour. 
# $opt_M = 1;
# Would default to 'always mirror file and
# execute' for instance, while
# $opt_f = 'dummy.pl';
# would default to 'always mirror as dummy.pl'.
# See the Getopt::Std manpage for more details.

# Get id or name of node to fetch:
my $node = shift;

# Invalid input, or -h option?
# If yes, print help and exit.
&print_help if( $opt_h || !$node );

# Put together URL to code to fetch:
# My old one commented out:
# my $url = "http://perlmonks.org/?node=$node&displaytype=displaycode";

# Patch for node_id by amoe:

# start amoe hack
my $url = 'http://www.perlmonks.org/index.pl?';
$url .= ($node =~ /^\d+$/ ? 'node_id' : 'node');
$url .= "=$node&displaytype=displaycode";
# end amoe hack


# Find first matching option, and take action :)
if( $opt_F )
{
    &do_execute( $opt_F, $opt_p );
}
elsif( $opt_f )
{
    &do_mirror( $opt_f );
    exit;
}
elsif( $opt_m )
{
    &do_mirror( $node );
    exit;
}
elsif ( $opt_M )
{
    &do_execute( $node, $opt_p );
}
else
{
    &do_eval();
}


# Download code and execute (eval) in memory.
# No mirroring is done. This is the default behavior.
#
sub do_eval
{
    my $code = get($url);
    
    if( $code )
    {
        if( $opt_d )
        {
            # Deparse code instead of running it:
            require B::Deparse;

            my $deparse = B::Deparse->new();

            print $deparse->coderef2text(eval qq(sub{$code}));
        }
        else
        {
            eval $code;
        }
    }
    else
    {
        die "Error when fetching: '$node', with url: '$url'!\n\n";
    }
}

# Download code and save as $filename.
#
# Args: $filename - the name of the file.
#
sub do_mirror
{
    my $filename = shift;
    
    # Make safer filename.
    $filename =~ s/[^\w\d\.]/_/g;
    
    chdir( $directory ) or die "Can't chdir to $directory";
    my $ret_code = mirror( $url, $filename );
    
    if( $ret_code == 200 && !$opt_q )
    {
        print "Saved '$node' as '$filename' in '$directory'\n\n";
    }
    else
    {
        die "Error when fetching: '$node', with url: '$url'!\n\n";
    }
    
    return $filename;
}

# Download code, save as $filename 
# and execute the file.
#
# Args: $filename - the name of the file.
#       $prepend - boolean. Explicitly
#                  execute with perl.
#
sub do_execute
{
    my $filename = shift;
    my $prepend = (shift) ? 'perl ' : '';
    
    # Deparse instead?
    $prepend = 'perl -MO=Deparse ' if $opt_d;
    
    # The filename gets "safed" in &do_mirror,
    # thus the return.
    $filename = &do_mirror( $filename );
    
    # Make file executable if needed.
    chmod 0755, $filename unless $prepend;
    
    # Using system and exit instead of exec
    # because of a DOS issue (prints output
    # strangely and may not exit correctly).
    # Other platforms do well with exec only.
    system( $prepend . $filename );
    exit;
}

# Print a (hopefully) friendly and informative
# help message.
#
sub print_help
{
    print<<HELP;

Usage: perl $0 [-options] nodeid|nodename

Options are:

-h              Print this help
-m              Mirror file to disk, using node_id
                or node_name as filename (might be
                a bad idea)
-M              Like -m, but also tries to execute
                file, chmod-ing to 0755 first.
-f filename     Like -m, but uses filename
                as the name to save with.
-F filename     Like -M, but uses filename
                as the name to save with.
-p              Used in combination with options
                m, M, f or F to explicitly invoke
                the program with the perl interpreter.
                (Prepends "perl " to the exec command).
                Currently, -p is on by default.
-d              Deparse code instead of executing it
                (Using B::Deparse). For in-memory
                deparsing, needs perl 5.6.1 or greater.
                Use together with -M or -F otherwise.
-q              Quiet mode. Only affects one message
                so we say it is for future purpose. :)

With no options, code is downloaded and simply eval'ed
in memory. No mirror is made on disk. Sometimes this will
not work as planned, then try -M or -F switches instead.
You can set where the code is saved in the script, default
is '/tmp/'. 

nodeid|nodename is either the id or the name/title of
the node. You can usually see the id by hovering over
the link. The title can also be used, but it may clash
with other nodes, in which case this will fail. It is
recommended to use the id. For names with spaces in them,
you need to use quotes around the name, like "word1 word2".

Note that running any program this way might be harmful,
as it executes foreign code (unless you just make mirrors).
Do not do this on nodes you have any reason to doubt.
HELP
exit;
}