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;

        write_file( $input->name, $input->content ) if ( $input->content );

        my $cmd = './' . $code->name . ' ' . $input->name;

        my $output = `$cmd 2>&1`;
        $output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;

        my $message = '$ ' . $cmd;

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

    $self->result->message( $message );
        $self->result->content( output => $output, cmd => $cmd );

    return 1;
}

1;

1	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	use Data::Dump qw/dump/;
14	use File::Temp qw/tempdir/;
15	use File::Slurp;
16	use Cwd qw/cwd/;
17
18	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	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	=cut
58
59	sub take_action {
60	my $self = shift;
61
62	my $code = Perly::Model::Code->new;
63	$code->load( $self->argument_value( 'code' ) ) or die "can't load code";
64
65	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
70	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
78	write_file( $input->name, $input->content ) if ( $input->content );
79
80	my $cmd = './' . $code->name . ' ' . $input->name;
81
82	my $output = `$cmd 2>&1`;
83	$output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;
84
85	my $message = '$ ' . $cmd;
86
87	chdir( $cwd ) \|\| die "can't return to $cwd";
88
89	$self->result->message( $message );
90	$self->result->content( output => $output, cmd => $cmd );
91
92	return 1;
93	}
94
95	1;
96