Perly/Action/Run.pm

use strict;
use warnings;

=head1 NAME

Perly::Action::Run

=cut

package Perly::Action::Run;
use base qw/Perly::Action Jifty::Action/;

use Data::Dump qw/dump/;
use File::Temp qw/tempdir/;
use File::Slurp;
use Cwd qw/cwd/;
use Perly::Depends;

use Jifty::Param::Schema;
use Jifty::Action schema {

param input =>
        label is 'Input data',
        available are defer {
                my $coll = Perly::Model::InputCollection->new;
                $coll->unlimit;
                [ '', {  
                        display_from => 'name',
                        value_from => 'id',
                        collection => $coll,
                }];
        },
        render as 'Select';

param code =>
        label is 'Source code',
        available are defer {
                my $coll = Perly::Model::CodeCollection->new;
                $coll->unlimit;
                [{  
                        display_from => 'name',
                        value_from => 'id',
                        collection => $coll,
                }];
        },
        render as 'Select',
        is mandatory;
};

sub sticky_on_success { 1 }
sub sticky_on_failure { 1 }

=head2 take_action

This action is B<huge security hole>. It executes script entered over web
page, without any sandboxing in new shell under user running Jifty.

=cut

sub take_action {
    my $self = shift;

        my $code = Perly::Model::Code->new;
        $code->load( $self->argument_value( 'code' ) ) or die "can't load code";

        my $input = Perly::Model::Input->new;
        if ( my $input_id = $self->argument_value( 'input' ) ) {
                $input->load( $input_id ) or die "can't load $input_id";
        }

        my $cwd = cwd;
        my $dir = tempdir( '/tmp/perly-XXXX', CLEANUP => 1 );

        chdir( $dir ) || die "can't chdir $dir";

        write_file( $code->name, $code->source ) or die "can't write " . $code->name . ": $!";
        chmod 0700, $code->name;
        my $cmd = './' . $code->name;
        my $message = '$ <a href="/edit?id=' . $code->id . '">' . $code->name . '</a>';

        my $deps = Perly::Depends->parse( $code->source );
        foreach my $module ( @{ $deps->{depends_on} } ) {
                my $filename = $module . '.pm';
                my $dep_code = Perly::Model::Code->new;
                $dep_code->load_by_cols( name => $filename );
                die "can't find $filename -- do you need to create it first?\n" unless ( $dep_code->id );
                write_file( $filename, $dep_code->source ) or die "can't write $filename: $!";
                warn "dependency $module in file $filename\n";
        }

        if ( $input->content ) {
                write_file( $input->name, $input->content ) or die "can't write " . $input->name . ": $!";
                $cmd .= ' ' . $input->name;
                $message .= ' ' . $input->name;
                $self->result->content( input => $input->content );
        }

        my $output;
        my $timeout = 5;

        eval {
                local $SIG{ALRM} = sub { die "Aborted execution after $timeout sec.\n" }; # NB: \n required
                alarm $timeout;
                $output = `$cmd 2>&1`;
                alarm 0;
        };
        if ($@) {
                die "$@\n" unless $@ eq "alarm\n";   # propagate unexpected errors
        }

        $output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;
        $self->result->content( output => $output );

        warn "$message\n$output\n";

        chdir( $cwd ) || die "can't return to $cwd";

    $self->result->message( $message );

        #warn "content in action = ",dump( $self->result->content );

    return 1;
}

1;

1	dpavlin	14	use strict;
2			use warnings;
3
4			=head1 NAME
5
6			Perly::Action::Run
7
8			=cut
9
10			package Perly::Action::Run;
11			use base qw/Perly::Action Jifty::Action/;
12
13	dpavlin	15	use Data::Dump qw/dump/;
14			use File::Temp qw/tempdir/;
15			use File::Slurp;
16			use Cwd qw/cwd/;
17	dpavlin	26	use Perly::Depends;
18	dpavlin	15
19	dpavlin	14	use Jifty::Param::Schema;
20			use Jifty::Action schema {
21
22			param input =>
23			label is 'Input data',
24			available are defer {
25			my $coll = Perly::Model::InputCollection->new;
26			$coll->unlimit;
27			[ '', {
28			display_from => 'name',
29			value_from => 'id',
30			collection => $coll,
31			}];
32			},
33			render as 'Select';
34
35			param code =>
36			label is 'Source code',
37			available are defer {
38			my $coll = Perly::Model::CodeCollection->new;
39			$coll->unlimit;
40			[{
41			display_from => 'name',
42			value_from => 'id',
43			collection => $coll,
44			}];
45			},
46			render as 'Select',
47			is mandatory;
48			};
49
50			sub sticky_on_success { 1 }
51			sub sticky_on_failure { 1 }
52
53			=head2 take_action
54
55	dpavlin	15	This action is B<huge security hole>. It executes script entered over web
56			page, without any sandboxing in new shell under user running Jifty.
57
58	dpavlin	14	=cut
59
60			sub take_action {
61			my $self = shift;
62
63	dpavlin	15	my $code = Perly::Model::Code->new;
64			$code->load( $self->argument_value( 'code' ) ) or die "can't load code";
65	dpavlin	14
66	dpavlin	15	my $input = Perly::Model::Input->new;
67			if ( my $input_id = $self->argument_value( 'input' ) ) {
68			$input->load( $input_id ) or die "can't load $input_id";
69			}
70	dpavlin	14
71	dpavlin	15	my $cwd = cwd;
72	dpavlin	27	my $dir = tempdir( '/tmp/perly-XXXX', CLEANUP => 1 );
73	dpavlin	15
74			chdir( $dir ) \|\| die "can't chdir $dir";
75
76	dpavlin	26	write_file( $code->name, $code->source ) or die "can't write " . $code->name . ": $!";
77	dpavlin	15	chmod 0700, $code->name;
78	dpavlin	17	my $cmd = './' . $code->name;
79	dpavlin	19	my $message = '$ <a href="/edit?id=' . $code->id . '">' . $code->name . '</a>';
80	dpavlin	15
81	dpavlin	26	my $deps = Perly::Depends->parse( $code->source );
82			foreach my $module ( @{ $deps->{depends_on} } ) {
83			my $filename = $module . '.pm';
84			my $dep_code = Perly::Model::Code->new;
85			$dep_code->load_by_cols( name => $filename );
86			die "can't find $filename -- do you need to create it first?\n" unless ( $dep_code->id );
87			write_file( $filename, $dep_code->source ) or die "can't write $filename: $!";
88			warn "dependency $module in file $filename\n";
89			}
90
91	dpavlin	17	if ( $input->content ) {
92	dpavlin	26	write_file( $input->name, $input->content ) or die "can't write " . $input->name . ": $!";
93	dpavlin	17	$cmd .= ' ' . $input->name;
94	dpavlin	19	$message .= ' ' . $input->name;
95	dpavlin	17	$self->result->content( input => $input->content );
96			}
97	dpavlin	15
98	dpavlin	26	my $output;
99			my $timeout = 5;
100
101			eval {
102			local $SIG{ALRM} = sub { die "Aborted execution after $timeout sec.\n" }; # NB: \n required
103			alarm $timeout;
104			$output = `$cmd 2>&1`;
105			alarm 0;
106			};
107			if ($@) {
108			die "$@\n" unless $@ eq "alarm\n"; # propagate unexpected errors
109			}
110
111	dpavlin	15	$output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;
112	dpavlin	17	$self->result->content( output => $output );
113	dpavlin	15
114	dpavlin	26	warn "$message\n$output\n";
115	dpavlin	17
116	dpavlin	15	chdir( $cwd ) \|\| die "can't return to $cwd";
117
118			$self->result->message( $message );
119
120	dpavlin	17	#warn "content in action = ",dump( $self->result->content );
121
122	dpavlin	15	return 1;
123	dpavlin	14	}
124
125			1;
126