1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 10:35:41 -04:00

Switch to Linux::Clone

This commit is contained in:
Ryan Voots 2017-05-12 21:05:54 -04:00
parent e1ea1bc82b
commit fe159c958d
9 changed files with 61 additions and 57 deletions

View file

@ -1,23 +0,0 @@
use POE::Filter::Reference;
use IO::Socket::INET;
use Data::Dumper;
my $filter = POE::Filter::Reference->new();
while( 1 ) {
print "Code: ";
my $code = <STDIN>;
my $socket = IO::Socket::INET->new( PeerAddr => 'simcop2387.info', PeerPort => '14400' );
my $refs = $filter->put( [ { code => "$code" } ] );
print $socket $refs->[0];
local $/;
my $output = <$socket>;
print "OUTPUT: ", Dumper($filter->get( [ $output ] )), "\n";
$socket->close;
}

View file

@ -1,8 +0,0 @@
#!/bin/bash
mkdir -p jail
mkdir -p jail/perl5
mkdir -p jail/lib
mkdir -p jail/usr/lib
mkdir -p jail/dev
mknod jail/dev/urandom c 1 9

View file

@ -1,5 +0,0 @@
#!/bin/bash
mount -o bind /home/ryan/perl5 jail/perl5
mount -o bind /lib jail/lib
mount -o bind /usr/lib jail/usr/lib

View file

@ -3,6 +3,7 @@ server "*" {
plugin "*" { addressed: true }
plugin "join" { access: op; addressed: true }
plugin "allowpaste" { access: op; addressed: true }
plugin "pastebinadmin" { access: op; addressed: true }
plugin "part" { access: op }
plugin "reload_plugins" { access: root }
plugin "restart" { access: root }

View file

@ -37,8 +37,10 @@ sub get_status {
my ($chancon) = @_;
my $status = dbh()->selectrow_hashref('SELECT value FROM allowpaste WHERE channel = ?', {}, $chancon);
my $global_status = dbh()->selectrow_hashref('SELECT value FROM allowpaste WHERE channel = ?', {}, 'GLOBAL');
warn "GET_STATUS $chancon\n";
return ($status // {})->{value};
return ($global_status // {value => 1})->{value} && ($status // {})->{value};
}
sub _start {

View file

@ -57,7 +57,9 @@ sub run_eval {
chdir($jail_path) or die "Jail not made, see bin/makejail.sh";
chroot($jail_path) or die $!;
system("/perl5/perlbrew/perls/perlbot-inuse/bin/perl", $filename);
#system("/perl5/perlbrew/perls/perlbot-inuse/bin/perl", $filename);
system($^X, $filename);
my ($exit, $signal) = (($?&0xFF00)>>8, $?&0xFF);
if ($exit) {

View file

@ -6,11 +6,36 @@ use warnings;
use Data::Dumper;
use List::Util qw/reduce uniq/;
use Moo;
use Sys::Linux::Unshare qw/:consts/;
use Linux::Clone;
use POSIX;
use Linux::Seccomp;
use Carp qw/croak/;
use constant {
CLONE_FILES => Linux::Clone::FILES,
CLONE_FS => Linux::Clone::FS,
CLONE_NEWNS => Linux::Clone::NEWNS,
CLONE_VM => Linux::Clone::VM,
CLONE_THREAD => Linux::Clone::THREAD,
CLONE_SIGHAND => Linux::Clone::SIGHAND,
CLONE_SYSVSEM => Linux::Clone::SYSVSEM,
CLONE_NEWUSER => Linux::Clone::NEWUSER,
CLONE_NEWPID => Linux::Clone::NEWPID,
CLONE_NEWUTS => Linux::Clone::NEWUTS,
CLONE_NEWIPC => Linux::Clone::NEWIPC,
CLONE_NEWNET => Linux::Clone::NEWNET,
CLONE_NEWCGROUP => Linux::Clone::NEWCGROUP,
CLONE_PTRACE => Linux::Clone::PTRACE,
CLONE_VFORK => Linux::Clone::VFORK,
CLONE_SETTLS => Linux::Clone::SETTLS,
CLONE_PARENT_SETTID => Linux::Clone::PARENT_SETTID,
CLONE_CHILD_SETTID => Linux::Clone::CHILD_SETTID,
CLONE_CHILD_CLEARTID => Linux::Clone::CHILD_CLEARTID,
CLONE_DETACHED => Linux::Clone::DETACHED,
CLONE_UNTRACED => Linux::Clone::UNTRACED,
CLONE_IO => Linux::Clone::IO,
};
has exec_map => (is => 'ro', default => sub {+{}});
has profiles => (is => 'ro'); # aref
@ -84,6 +109,7 @@ our %rule_sets = (
{syscall => 'close'},
{syscall => 'select'},
{syscall => 'read'},
{syscall => 'pread64'},
{syscall => 'lseek'},
{syscall => 'fstat'}, # default? not file_open?
{syscall => 'stat'},
@ -110,7 +136,9 @@ our %rule_sets = (
},
file_write => {
permute => {open_modes => [&POSIX::O_CREAT,&POSIX::O_WRONLY, &POSIX::O_TRUNC, &POSIX::O_RDWR]},
rules => [{syscall => 'write'}],
rules => [{syscall => 'write'},
{syscall => 'pwrite64'},
],
include => ['file_open', 'file_readonly'],
},

View file

@ -291,6 +291,7 @@ use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on dem
# Setup SECCOMP for us
my ($profile) = ($type =~ /^([a-z]+)/ig);
$profile = "perl" if $type eq 'deparse';
my $esc = EvalServer::Seccomp->new(profiles => ["lang_$profile"], exec_map => \%exec_map);
$esc->engage();

View file

@ -34,9 +34,7 @@ sub postload {
value INTEGER NOT NULL,
setby VARCHAR(255) NOT NULL,
set_date INTEGER NOT NULL
);
";
);";
$pm->create_table( $self->dbh, "allowpaste", $sql );
@ -65,7 +63,13 @@ sub set_status {
sub command {
my( $self, $said, $pm ) = @_;
my( $set_to ) = @{ $said->{recommended_args} };
my( $cmd ) = join ' ', @{ $said->{recommended_args} };
my ($global, $set_to);
if ($cmd =~ /^\s*(?<global>global)?\s*(?<set_to>on|off)?\s*$/i) {
$global = $+{global} // "channel";
$set_to = $+{set_to};
}
my $server_conf = $pm->{bb3}{'Bot::BB3::Roles::IRC'}{bot_confs}{$said->{pci_id}};
my ($botname, $servername) = @{$server_conf}{qw/botname server/};
@ -73,12 +77,14 @@ sub command {
my $chanconstruct = "$servername:$botname:$channel";
$chanconstruct = "GLOBAL" if $global eq 'global';
if ($set_to && (lc($set_to) eq 'on' || lc($set_to) eq 'off')) {
$self->set_status($chanconstruct, $set_to, $said->{name});
return('handled', "This channel has pastebin set [$set_to]");
return('handled', "This $global has pastebin set [$set_to]");
} else {
my $status = $self->get_status($chanconstruct)//1 ? 'on' : 'off';
return('handled', "This channel has pastebin set to [$status] :: $chanconstruct");
return('handled', "This $global has pastebin set to [$status] :: $chanconstruct");
}
}
@ -86,5 +92,5 @@ no warnings 'void';
"Bot::BB3::Plugin::Allowpaste";
__DATA__
The allowpaste plugin. Lets operators disable pastes being announced in the channel. allowpaste [on|off] => Tell you the state, or turn it on or off.
The allowpaste plugin. Lets operators disable pastes being announced in the channel. allowpaste [global] [on|off] => Tell you the state, or turn it on or off.
See https://github.com/perlbot/perlbuut-pastebin/wiki/Op-Tools for more documentation