Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Run and/or download code directly from perlmonk nodes.

by Dog and Pony (Priest)
on Mar 24, 2002 at 02:08 UTC ( [id://153861]=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info Kristoffer Lundén <kung.stoffe@home.se>
Description: Tired of copy/paste, save and then execute obfuscations, poetry or other code from interesting nodes? This small command line utility will do it for you. By default it takes the code from a node and simply evals it, but it can also download a copy with or without executing it. It uses LWP::Simple for the fetching. Use the option '-h' and read the embedded comments for more info.

Please read the warnings about possible dangers. Do not simply execute any code/node you have reason to distrust, but that of course goes for manual downloads as well. This does work well for just downloading too though, if you just want to poke around in a script. :)

Update: The provided patch by Amoe has been applied. My way worked for me on Win2k, cygwin and FreeBSD, so I lazied out on this one. :) Thanks Amoe!

Update 2: Suggestion 2 by belg4mit should be working now: Using the -d option for deparsing instead of executing should now work. Note that in-memory-deparsing uses a new feauture (v5.6.1?) in B::Deparse that won't work with older perls. Use together with -M or -F instead.

#!/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;
}
Replies are listed 'Best First'.
Re: Run and/or download code directly from perlmonk nodes.
by belg4mit (Prior) on Mar 24, 2002 at 03:03 UTC
    I would highly recommend incorporating Safe into this; it's surprisingly easy, an informative module, etc. And perhaps an option for B::Deparse ;-)

    --
    perl -pe "s/\b;([st])/'\1/mg"

      Very good ideas (++ indeed)!

      As might be guessed, this all started with a oneliner to scratch an itch, that just swelled (just... one... more... feature...) so I totally forgot about Safe. /me hangs head in shame. B::Deparse is of course also a great idea, since at least my main use is for obfus.

      Maybe I will have the time later today. Thanks! :)

      Update: I have decided to not implement Safe for now, at least. Reason for this is simple: I would have to allow eval as default, as so many nodes I use it on are obfus, and eval sets Safe aside anyways. When eval is not involved, you can usually determine if the script is safe anyways. Or you can just mirror the code, or deparse it - and if you don't trust it, don't run it (which is the same if you copy/paste also). If someone wants to patch the program with Safe, I'd be more than happy to incorporate it, but it is no feature I feel I need myself.


      You have moved into a dark place.
      It is pitch black. You are likely to be eaten by a grue.
Re: Run and/or download code directly from perlmonk nodes.
by Amoe (Friar) on Mar 24, 2002 at 17:38 UTC

    Nice script, Dog and Pony. ++.

    It didn't work straight out of the box for me, though. It failed whenever I tried to use a node id rather than a name. A little patch at around line 69:

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

    That fixes it, unless you use a number for the title of a node, in which case you can just use the node_id instead.


    --
    my one true love
Re: Run and/or download code directly from perlmonk nodes.
by diotalevi (Canon) on Aug 20, 2003 at 22:55 UTC

    Most of the time I just use an even simpler shell script and redirect to whatever I feel needs the code. So `pmget 153861 | perl` would download the code from your node and just run it.

    #!/bin/sh lynx -source "http://www.perlmonks.org/index.pl?displaytype=displaycod +e&node=$1"

    Updated to add the displaytype=displaycode. I was typing it from memory and forgot that part. Oops!

      Heh. Suddenly this old node pops up and has a reply. :)

      Anyhow, almost any problem has multiple solutions, as usual. Yours doesn't work, for one thing - but that is a typo, right? ;-) Missing a &displaytype=displaycode if I read it correctly, I did not try it.

      With the typo fixed, I suppose it does (some of) the same job nicely, as long as one has lynx installed. I seem to recall that this script scratched an itch on Windows (which has lynx available if needs be), but mainly, all those scripts written and posted in those days was to learn and have fun.

      Fun to be reminded of the things one once did. :)


      You have moved into a dark place.
      It is pitch black. You are likely to be eaten by a grue.

      maybe i'm crazy...but wouldn't that get all the source... including the tables etc?

      ___________
      Eric Hodges
Re: Run and/or download code directly from perlmonk nodes.
by Intrepid (Deacon) on Sep 03, 2003 at 06:09 UTC

    I *like* it!

    A fellow Monk and I recently wrote a tool like this ourselves, but the in-memory eval() isn't a capability of our implementation. Anyway, I have a slight improvement to offer on your script. It concerns the mundane issue of where to save a file on disk. Your default /tmp would be fine on a single-user workstation but I thought about a multi-user system where security / privacy might be a greater concern, and one would want to confine one's activities to one's ~USER/ ($HOME) dir.

    This small patch makes sure that such a directory exists before allowing the script to continue if writing to disk is going to be needed.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://153861]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2024-03-19 13:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found