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 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 => 0 );

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

        write_file( $code->name, $code->source );
        chmod 0700, $code->name;
        my $cmd = './' . $code->name;
        my $message = '$ <a href="/edit?id=' . $code->id . '">' . $code->name . '</a>';

        if ( $input->content ) {
                write_file( $input->name, $input->content );
                $cmd .= ' ' . $input->name;
                $message .= ' ' . $input->name;
                $self->result->content( input => $input->content );
        }

        my $output = `$cmd 2>&1`;
        $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
18	dpavlin	14	use Jifty::Param::Schema;
19			use Jifty::Action schema {
20
21			param input =>
22			label is 'Input data',
23			available are defer {
24			my $coll = Perly::Model::InputCollection->new;
25			$coll->unlimit;
26			[ '', {
27			display_from => 'name',
28			value_from => 'id',
29			collection => $coll,
30			}];
31			},
32			render as 'Select';
33
34			param code =>
35			label is 'Source code',
36			available are defer {
37			my $coll = Perly::Model::CodeCollection->new;
38			$coll->unlimit;
39			[{
40			display_from => 'name',
41			value_from => 'id',
42			collection => $coll,
43			}];
44			},
45			render as 'Select',
46			is mandatory;
47			};
48
49			sub sticky_on_success { 1 }
50			sub sticky_on_failure { 1 }
51
52			=head2 take_action
53
54	dpavlin	15	This action is B<huge security hole>. It executes script entered over web
55			page, without any sandboxing in new shell under user running Jifty.
56
57	dpavlin	14	=cut
58
59			sub take_action {
60			my $self = shift;
61
62	dpavlin	15	my $code = Perly::Model::Code->new;
63			$code->load( $self->argument_value( 'code' ) ) or die "can't load code";
64	dpavlin	14
65	dpavlin	15	my $input = Perly::Model::Input->new;
66			if ( my $input_id = $self->argument_value( 'input' ) ) {
67			$input->load( $input_id ) or die "can't load $input_id";
68			}
69	dpavlin	14
70	dpavlin	15	my $cwd = cwd;
71			my $dir = tempdir( '/tmp/perly-XXXX', CLEANUP => 0 );
72
73			chdir( $dir ) \|\| die "can't chdir $dir";
74
75			write_file( $code->name, $code->source );
76			chmod 0700, $code->name;
77	dpavlin	17	my $cmd = './' . $code->name;
78	dpavlin	19	my $message = '$ <a href="/edit?id=' . $code->id . '">' . $code->name . '</a>';
79	dpavlin	15
80	dpavlin	17	if ( $input->content ) {
81			write_file( $input->name, $input->content );
82			$cmd .= ' ' . $input->name;
83	dpavlin	19	$message .= ' ' . $input->name;
84	dpavlin	17	$self->result->content( input => $input->content );
85			}
86	dpavlin	15
87			my $output = `$cmd 2>&1`;
88			$output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;
89	dpavlin	17	$self->result->content( output => $output );
90	dpavlin	15
91	dpavlin	17	#warn "$message\n$output\n";
92
93	dpavlin	15	chdir( $cwd ) \|\| die "can't return to $cwd";
94
95			$self->result->message( $message );
96
97	dpavlin	17	#warn "content in action = ",dump( $self->result->content );
98
99	dpavlin	15	return 1;
100	dpavlin	14	}
101
102			1;
103