1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
#!/usr/bin/perl
use strict;
use IO::File;
use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
use Data::Dumper;
require 'syscall.ph'; # for SYS_mknod and SYS_lchown
my ($rootdir) = @ARGV;
# strip leading and trailing slashes
$rootdir = $1 if($rootdir =~ /^\/?(.*)\/?$/);
sub fixup { return "/$rootdir" . shift }
sub x_getattr {
my ($file) = fixup(shift);
my (@list) = lstat($file);
return -$! unless @list;
return @list;
}
sub x_getdir {
my ($dirname) = fixup(shift);
unless(opendir(DIRHANDLE,$dirname)) {
return -ENOENT();
}
my (@files) = readdir(DIRHANDLE);
closedir(DIRHANDLE);
return (@files, 0);
}
sub x_open {
my ($file) = fixup(shift);
my ($mode) = shift;
return -$! unless sysopen(FILE,$file,$mode);
close(FILE);
return 0;
}
sub x_read {
my ($file,$bufsize,$off) = @_;
my ($rv) = -ENOSYS();
my ($handle) = new IO::File;
return -ENOENT() unless -e ($file = fixup($file));
my ($fsize) = -s $file;
return -ENOSYS() unless open($handle,$file);
if(seek($handle,$off,SEEK_SET)) {
read($handle,$rv,$bufsize);
}
return $rv;
}
sub x_write {
my ($file,$buf,$off) = @_;
my ($rv);
return -ENOENT() unless -e ($file = fixup($file));
my ($fsize) = -s $file;
return -ENOSYS() unless open(FILE,'+<',$file);
if($rv = seek(FILE,$off,SEEK_SET)) {
$rv = print(FILE $buf);
}
$rv = -ENOSYS() unless $rv;
close(FILE);
return length($buf);
}
sub err { return (-shift || -$!) }
sub x_readlink { return readlink(fixup(shift) ); }
sub x_unlink { return unlink(fixup(shift)) ? 0 : -$!; }
sub x_rmdir { return err(rmdir(fixup(shift)) ); }
sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
sub x_rename {
my ($old) = fixup(shift);
my ($new) = fixup(shift);
my ($err) = rename($old,$new) ? 0 : -ENOENT();
return $err;
}
sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
sub x_chown {
my ($fn) = fixup(shift);
print "nonexistent $fn\n" unless -e $fn;
my ($uid,$gid) = @_;
# perl's chown() does not chown symlinks, it chowns the symlink's
# target. it fails when the link's target doesn't exist, because
# the stat64() syscall fails.
# this causes error messages when unpacking symlinks in tarballs.
my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
return $err;
}
sub x_chmod {
my ($fn) = fixup(shift);
my ($mode) = shift;
my ($err) = chmod($mode,$fn) ? 0 : -$!;
return $err;
}
sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
sub x_mknod {
# since this is called for ALL files, not just devices, I'll do some checks
# and possibly run the real mknod command.
my ($file, $modes, $dev) = @_;
$file = fixup($file);
$! = 0;
syscall(&SYS_mknod,$file,$modes,$dev);
return -$!;
}
# kludge
sub x_statfs {return 255,1000000,500000,1000000,500000,4096}
$| = 1;
my ($len);
while(read(STDIN,$len,9) == 9) {
chomp $len;
my ($data,$VAR1,@args);
eval {
$SIG{ALRM} = sub { die "timeout\n"};
$data = "";
alarm 5;
read(STDIN,$data,$len-length($data),length($data))
while(length($data) < $len);
alarm 0;
};
die $@ if $@;
eval $data;
@args = @{$VAR1};
my $cmd = shift(@args);
exit 0 if $cmd eq "bye";
die "cannot find command $cmd\n" unless exists($main::{"x_$cmd"});
@args = $main::{"x_$cmd"}(@args);
$cmd = Dumper(\@args)."\n";
$cmd = sprintf("%08i\n%s",length($cmd),$cmd);
print $cmd;
}
|
