File Coverage

blib/lib/Language/Frink/Eval.pm
Criterion Covered Total %
statement 23 55 41.8
branch 0 12 0.0
condition n/a
subroutine 8 11 72.7
pod 2 4 50.0
total 33 82 40.2


line stmt bran cond sub pod time code
1             package Language::Frink::Eval;
2              
3             =head1 NAME
4              
5             Language::Frink::Eval
6              
7             =head1 DESCRIPTION
8              
9             This module is a simple wrapper around the Frink interpreter written by Alan
10             Eliasen. As such, it requires a local copy of the Java interpreter and the
11             C file. For more information on Frink, please see
12             L. This module works by starting a JVM
13             as a child process, and sending Frink expressions to it via a pipe, and
14             retrieving the results the same way. Also, this module has the ability to
15             function in a restricted mode it attempts to filter "dangerous" expressions,
16             such as functions that read files from local disk, the network, and also
17             commands that may persistantly change the interpreter state.
18              
19             The list of "dangerous" functions and expressions was derived by reading the
20             Frink documentation, and probably is not complete. If you find
21             commands that get through the filter that should, please report them.
22              
23             =cut
24              
25 1     1   23086 use strict;
  1         3  
  1         33  
26 1     1   4 use warnings;
  1         2  
  1         27  
27 1     1   893 use Params::Validate qw(:all);
  1         10787  
  1         297  
28 1     1   1012 use IPC::Open2;
  1         5732  
  1         115  
29 1     1   1857 use IO::Select;
  1         2476  
  1         71  
30 1     1   9 use Carp;
  1         2  
  1         1204  
31              
32             our $VERSION = '0.02';
33              
34             =pod
35              
36             The following functions are not allowed in restricted mode:
37              
38             =over
39              
40             =item C
41              
42             =item C
43              
44             =item C
45              
46             =item C
47              
48             =item C
49              
50             =item C
51              
52             =item C
53              
54             =item C
55              
56             =back
57              
58             =cut
59              
60             my @bannedFunctions = (
61             'lines', 'read', 'eval', 'input',
62             'select', 'callJava', 'newJava', 'staticJava',
63             );
64              
65             =pod
66              
67             The following language constructs are not allowed in restricted mode:
68              
69             =over
70              
71             =item Regexes
72              
73             =item Function Declarations
74              
75             =item Unit display format
76              
77             =item Loops
78              
79             =item Time display format
80              
81             =item Procedure blocks
82              
83             =item File inclusion
84              
85             =item Class Declaration
86              
87             =back
88              
89             =cut
90              
91             my %bannedRegex = (
92             '=~' => 'Regular expressions are not allowed',
93             ':=' => 'Function declarations are not allowed',
94             ':->' => 'Display format cannot be changed',
95             'while[\s{]' => "'while' loops are not allowed",
96             '(^|\s+)for[\s{]' => "'for loops are not allowed",
97             '####' => 'Cannot redefine the default time format',
98             '{.+}' => 'Procedure blocks are not allowed',
99             '(^|\s+)use\s+' => 'File inclusion not allowed',
100             '(^|\s+)class\s+\S+' => 'Class declaration not allowed',
101             );
102              
103             =head1 METHODS
104              
105             =head2 C ..., etc)>
106              
107             This method will create a new Language::Frink::Eval object, and start up an
108             external Frink interpreter in a JVM. If it encounters any problems when
109             starting the JVM, then it will call C.
110              
111             =head3 CONSTRUCTOR PARAMETERS
112              
113             These parameters are B case sensitive.
114              
115             =over 4
116              
117             =item Restricted
118              
119             This is a boolean value. If it is true, then expressions will be filtered to
120             attempt to prevent "dangerous" expressions from being evaluated.
121              
122             =item JavaPath
123              
124             This specifies the entire commandline to run. This defaults to C
125             frink.jar frink.parser.Frink>. If the java interpreter is not in your path, or
126             if the C is not in your current directory, then you will need to
127             change this.
128              
129             =back
130              
131             =cut
132              
133             sub new {
134 1     1 1 13 my $class = shift;
135             my %p = validate_with(
136             params => \@_,
137             spec => {
138             RunCommand => {
139             type => SCALAR,
140             default => "java -cp frink.jar frink.parser.Frink",
141             optional => 1
142             },
143             Restricted => {
144             type => SCALAR,
145             default => 0,
146             optional => 1,
147             },
148             },
149 3     3   28 normalize_keys => sub { lc($_[0]) },
150 1         49 );
151              
152 1         10 my ($rfh, $wfh);
153 1         6 my $pid = open2($rfh, $wfh, $p{runcommand});
154             # TODO: Verify that this returns a copyright string.
155 0           my $copyright = <$rfh>;
156 0           my $self = {
157             pid => $pid,
158             rfh => $rfh,
159             wfh => $wfh,
160             sel => IO::Select->new($rfh),
161             restricted => $p{restricted},
162             };
163 0           bless $self, $class;
164 0           $self;
165             }
166              
167             sub filterExpression {
168 0     0 0   my $expr = shift;
169              
170 0           foreach my $regex (keys %bannedRegex) {
171 0 0         if ($expr =~ /$regex/i) {
172 0           croak $bannedRegex{$regex};
173             }
174             }
175              
176 0           foreach my $func (@bannedFunctions) {
177 0 0         if ($expr =~ /(^|\s+)$func\s*\[/i) {
178 0           croak "Function $func is not allowed";
179             }
180             }
181              
182 0           $expr =~ s/[[:cntrl:]]//g;
183              
184 0           $expr;
185             }
186              
187             sub restricted {
188 0     0 0   my $self = shift;
189 0           my $flag = shift;
190              
191 0           my $old = $self->{restricted};
192 0 0         $self->{restricted} = $flag if defined $flag;
193 0           $old;
194             }
195              
196             =head2 C
197              
198             This passes the expression that is given to the Frink interpreter, and returns
199             the results as a string. This may return a single string will multiple embedded
200             newlines. If the interpreter's results end in a newline, then it will be removed
201             before returning, to make processing the common case of a single line result
202             easier. If the object is set to C then results will be filtered
203             before evaluation. If it is determined that the expression cannot be evaluated
204             due to policy, then the program will C with an error message describing
205             why.
206              
207             =cut
208              
209             sub eval {
210 0     0 1   my $self = shift;
211 0           my $expr = shift;
212 0 0         $expr = filterExpression($expr) if $self->{restricted};
213 0           my ($wfh, $rfh) = ($self->{wfh}, $self->{rfh});
214 0           print $wfh "$expr\n";
215 0           my $result = '';
216 0           while (1) {
217 0           my @ready = $self->{sel}->can_read(0.1);
218 0 0         if (@ready == 0) {
219 0 0         if ($result ne '') {
220 0           chomp($result);
221 0           return $result;
222             } else {
223 0           next;
224             }
225             }
226 0           sysread($rfh, $result, 4096, length($result));
227             }
228             }
229              
230             =head1 FILES
231              
232             This module requires a Java interpreter and a local copy of C.
233              
234             =head1 LICENSE
235              
236             This program is free software; you can redistribute it and/or modify it under
237             the same terms as Perl itself.
238              
239             See L.
240              
241             =head1 AUTHOR
242              
243             Clayton O'Neill Econeill@oneill.netE
244              
245             =cut
246              
247             1;