| 1 | #! perl |
1 | #! perl |
| 2 | |
|
|
| 3 | # untested dm support extension |
|
|
| 4 | |
2 | |
| 5 | use Storable qw/nfreeze thaw/; |
3 | use Storable qw/nfreeze thaw/; |
| 6 | |
4 | |
| 7 | my %global; # for use by eval'ed commands |
5 | my %global; # for use by eval'ed commands |
| 8 | |
6 | |
| 9 | cf::register_extcmd perl_eval => sub { |
7 | cf::register_extcmd perl_eval => sub { |
| 10 | my ($pl, $data) = @_; |
8 | my ($pl, $data) = @_; |
| 11 | |
9 | |
| 12 | my ($token, $data) = split / /, $data, 2; |
10 | my ($token, $data) = split / /, $data, 2; |
| 13 | |
11 | |
| 14 | unless ($pl->flag (cf::FLAG_WIZ)) { |
12 | unless ($pl->ob->flag (cf::FLAG_WIZ)) { |
| 15 | $pl->send ("ext $token error permission denied"); |
13 | $pl->send ("ext $token error permission denied"); |
| 16 | return; |
14 | return; |
| 17 | } |
15 | } |
| 18 | |
16 | |
| 19 | my ($code, $arg) = split /\0/, $data, 2; |
17 | my ($code, $arg) = split /\0/, $data, 2; |
| 20 | |
18 | |
| 21 | $arg = eval { thaw $arg }; |
19 | $arg = eval { thaw $arg }; |
| 22 | my @res = eval $code; |
20 | my @res = eval $code; |
| 23 | |
21 | |
| 24 | $@ ? $pl->send ("ext $token error " . nfreeze $@) |
22 | $@ ? $pl->send ("ext $token error $@") |
| 25 | : $pl->send ("ext $token ok " . nfreeze \@res); |
23 | : $pl->send ("ext $token ok " . nfreeze \@res); |
| 26 | }; |
24 | }; |
