kio-extras/fish/fish.pl

0001 #!/usr/bin/perl
0002 # SPDX-License-Identifier: GPL-2.0-only
0003 =pod
0004 This file was transferred by kio_fish, a network client part of the
0005 KDE project. You may safely delete it, it will be transferred again
0006 when needed.
0007 =cut
0008
0009 use Fcntl;
0010
0011 $|++;
0012 #open(DEBUG,">/tmp/kio_fish.debug.$$.log");
0013 # save code in initial directory if just transferred
0014 if (defined $code) {
0015     unlink('.fishsrv.pl');
0016     sysopen(FH,'.fishsrv.pl',O_WRONLY|O_CREAT|O_EXCL);
0017     print FH $code;
0018     close(FH);
0019     chmod(0444,'.fishsrv.pl');
0020 # request new code if it changed (checksum mismatch)
0021 # for automatic upgrades
0022 } elsif ($ARGV[0] ne "{CHECKSUM}") {
0023     $|=1;
0024     print "### 100 transfer fish server\n";
0025     while(<STDIN>) {
0026         last if /^__END__/;
0027         $code.=$_;
0028     }
0029     exit(eval($code));
0030 }
0031
0032 # we are up and running.
0033 print "### 200\n";
0034 use strict;
0035 use POSIX qw(getcwd dup2 strftime);
0036 $SIG{'CHLD'} = 'IGNORE';
0037 $| = 1;
0038 MAIN: while (<STDIN>) {
0039     chomp;
0040     chomp;
0041     next if !length($_) || substr($_,0,1) ne '#';
0042 #print DEBUG "$_\n";
0043     s/^#//;
0044     /^VER / && do {
0045         # We do not advertise "append" capability anymore, as "write" is
0046         # as fast in perl mode and more reliable (overlapping writes)
0047         print "VER 0.0.3 copy lscount lslinks lsmime exec stat\n### 200\n";
0048         next;
0049     };
0050     /^PWD$/ && do {
0051         print getcwd(),"\n### 200\n";
0052         next;
0053     };
0054     /^SYMLINK\s+((?:\\.|[^\\])*?)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0055         my $ofn = unquote($1);
0056         my $fn = unquote($2);
0057         print (symlink($ofn,$fn)?"### 200\n":"### 500 $!\n");
0058         next;
0059     };
0060     /^COPY\s+((?:\\.|[^\\])*?)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0061         my $ofn = unquote($1);
0062         my $fn = unquote($2);
0063         my ($size) = (stat($ofn))[7];
0064         my $read = 1;
0065         if (-l $ofn) {
0066             my $dest = readlink($ofn);
0067             unlink($fn);
0068             symlink($dest,$fn) || ($read = 0);
0069         } else {
0070             sysopen(FH,$ofn,O_RDONLY) || do { print "### 500 $!\n"; next; };
0071             sysopen(OFH,$fn,O_WRONLY|O_CREAT|O_TRUNC) || do { close(FH); print "### 500 $!\n"; next; };
0072             local $/ = undef;
0073             my $buffer = '';
0074             while ($size > 32768 && ($read = sysread(FH,$buffer,32768)) > 0) {
0075                 $size -= $read;
0076                 if (syswrite(OFH,$buffer,$read) != $read) {
0077                     close(FH); close(OFH);
0078                     print "### 500 $!\n";
0079                     next MAIN;
0080                 }
0081
0082             }
0083             while ($size > 0 && ($read = sysread(FH,$buffer,$size)) > 0) {
0084                 $size -= $read;
0085                 if (syswrite(OFH,$buffer,$read) != $read) {
0086                     close(FH); close(OFH);
0087                     print "### 500 $!\n";
0088                     next MAIN;
0089                 }
0090             }
0091             close(FH);
0092             close(OFH);
0093         }
0094         if ($read > 0) {
0095             print "### 200\n";
0096         } else {
0097             print "### 500 $!\n";
0098         }
0099         next;
0100     };
0101     /^LINK\s+((?:\\.|[^\\])*?)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0102         my $ofn = unquote($1);
0103         my $fn = unquote($2);
0104         print (link($ofn,$fn)?"### 200\n":"### 500 $!\n");
0105         next;
0106     };
0107     /^RENAME\s+((?:\\.|[^\\])*?)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0108         my $ofn = unquote($1);
0109         my $fn = unquote($2);
0110         print (rename($ofn,$fn)?"### 200\n":"### 500 $!\n");
0111         next;
0112     };
0113     /^CHGRP\s+(\d+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0114         my $fn = unquote($2);
0115         print (chown(-1,int($1),$fn)?"### 200\n":"### 500 $!\n");
0116         next;
0117     };
0118     /^CHOWN\s+(\d+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0119         my $fn = unquote($2);
0120         print (chown(int($1),-1,$fn)?"### 200\n":"### 500 $!\n");
0121         next;
0122     };
0123     /^CHMOD\s+([0-7]+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0124         my $fn = unquote($2);
0125         print (chmod(oct($1),$fn)?"### 200\n":"### 500 $!\n");
0126         next;
0127     };
0128     /^DELE\s+((?:\\.|[^\\])*?)\s*$/ && do {
0129         my $fn = unquote($1);
0130         print (unlink($fn)?"### 200\n":"### 500 $!\n");
0131         next;
0132     };
0133     /^RMD\s+((?:\\.|[^\\])*?)\s*$/ && do {
0134         my $dn = unquote($1);
0135         print (rmdir($dn)?"### 200\n":"### 500 $!\n");
0136         next;
0137     };
0138     /^MKD\s+((?:\\.|[^\\])*?)\s*$/ && do {
0139         my $dn = unquote($1);
0140         if (mkdir($dn,0777)) {
0141           print "### 200\n";
0142         } else {
0143           my $err = $!;
0144           print (chdir($dn)?"### 501 $err\n":"### 500 $err\n");
0145         }
0146         next;
0147     };
0148     /^CWD\s+((?:\\.|[^\\])*?)\s*$/ && do {
0149         my $dn = unquote($1);
0150         print (chdir($dn)?"### 200\n":"### 500 $!\n");
0151         next;
0152     };
0153     /^LIST\s+((?:\\.|[^\\])*?)\s*$/ && do {
0154         list($1, 1);
0155         next;
0156     };
0157     /^STAT\s+((?:\\.|[^\\])*?)\s*$/ && do {
0158         list($1, 0);
0159         next;
0160     };
0161     /^WRITE\s+(\d+)\s+(\d+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0162         write_loop($2,$3,O_WRONLY|O_CREAT,$1);
0163         next;
0164     };
0165     /^APPEND\s+(\d+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0166         write_loop($1,$2,O_WRONLY|O_APPEND);
0167         next;
0168     };
0169     /^STOR\s+(\d+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0170         write_loop($1,$2,O_WRONLY|O_CREAT|O_TRUNC);
0171         next;
0172     };
0173     /^RETR\s+((?:\\.|[^\\])*?)\s*$/ && do {
0174         read_loop($1);
0175         next;
0176     };
0177     /^READ\s+(\d+)\s+(\d+)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0178         read_loop($3,$2,$1);
0179         next;
0180     };
0181     /^EXEC\s+((?:\\.|[^\\])*?)\s+((?:\\.|[^\\])*?)\s*$/ && do {
0182         my $tempfile = unquote($2);
0183         my $command = unquote($1);
0184         $command = $command . ";echo \"###RESULT: \$?\"";
0185         print("### 500 $!\n"), next
0186             if (!sysopen(FH,$tempfile,O_CREAT|O_EXCL|O_WRONLY,0600));
0187         my $pid = fork();
0188         print("### 500 $!\n"), next
0189             if (!defined $pid);
0190         if ($pid == 0) {
0191             open(STDOUT,'>>&FH');
0192             open(STDERR,'>>&FH');
0193             open(STDIN,'</dev/null'); # not sure here, ms windows anyone?
0194             exec('/bin/sh','-c',$command);
0195             print STDERR "Couldn't exec /bin/sh: $!\n";
0196             exit(255);
0197         }
0198         waitpid($pid,0);
0199         close(FH);
0200         print "### 200\n";
0201         next;
0202     };
0203 }
0204 exit(0);
0205
0206 sub list {
0207     my $dn = unquote($_[0]);
0208     my @entries;
0209     if (!-e $dn) {
0210         print "### 404 File does not exist\n";
0211         return;
0212     } elsif ($_[1] && -d _) {
0213         opendir(DIR,$dn) || do { print "### 500 $!\n"; return; };
0214         @entries = readdir(DIR);
0215         closedir(DIR);
0216     } else {
0217         ($dn, @entries) = $dn =~ m{(.*)/(.*)};
0218         $dn = '/' if (!length($dn));
0219     }
0220     print scalar(@entries),"\n### 100\n";
0221     my $cwd = getcwd();
0222     chdir($dn) || do { print "### 500 $!\n"; return; };
0223     foreach (@entries) {
0224         $_ = '.' if (!length($_));
0225         my $link = readlink;
0226         my ($mode,$uid,$gid,$size,$mtime) = (lstat)[2,4,5,7,9];
0227         print filetype($mode,$link,$uid,$gid);
0228         print "S$size\n";
0229         print strftime("D%Y %m %d %H %M %S\n",localtime($mtime));
0230         print ":$_\n";
0231         print "L$link\n" if defined $link;
0232         print mimetype($_);
0233         print "\n";
0234     }
0235     chdir($cwd);
0236     print "### 200\n";
0237 }
0238
0239 sub read_loop {
0240     my $fn = unquote($_[0]);
0241     my ($size) = ($_[1]?int($_[1]):(stat($fn))[7]);
0242     my $error = '';
0243     print "### 501 Is directory\n" and return if -d $fn;
0244     sysopen(FH,$fn,O_RDONLY) || ($error = $!);
0245     if ($_[2]) {
0246         sysseek(FH,int($_[2]),0) || do { close(FH); $error ||= $!; };
0247     }
0248     print "### 500 $error\n" and return if $error;
0249     if (@_ < 2) {
0250         print "$size\n";
0251     }
0252     print "### 100\n";
0253     my $buffer = '';
0254     my $read = 1;
0255     while ($size > 32768 && ($read = sysread(FH,$buffer,32768)) > 0) {
0256 #print DEBUG "$size left, $read read\n";
0257         $size -= $read;
0258         print $buffer;
0259     }
0260     while ($size > 0 && ($read = sysread(FH,$buffer,$size)) > 0) {
0261 #print DEBUG "$size left, $read read\n";
0262         $size -= $read;
0263         print $buffer;
0264     }
0265     while ($size > 0) {
0266         print ' ';
0267         $size--;
0268     }
0269     $error ||= $! if $read <= 0;
0270     close(FH);
0271     if (!$error) {
0272         print "### 200\n";
0273     } else {
0274         print "### 500 $error\n";
0275     }
0276 }
0277
0278 sub write_loop {
0279     my $size = int($_[0]);
0280     my $fn = unquote($_[1]);
0281 #print DEBUG "write_loop called $size size, $fn fn, $_[2]\n";
0282     my $error = '';
0283     sysopen(FH,$fn,$_[2]) || do { print "### 400 $!\n"; return; };
0284     eval { flock(FH,2); };
0285     if ($_[3]) {
0286         sysseek(FH,int($_[3]),0) || do { close(FH);print "### 400 $!\n"; return; };
0287     }
0288     <STDIN>;
0289     print "### 100\n";
0290     my $buffer = '';
0291     my $read = 1;
0292     while ($size > 32768 && ($read = read(STDIN,$buffer,32768)) > 0) {
0293 #print DEBUG "$size left, $read read\n";
0294         $size -= $read;
0295         $error ||= $! if (syswrite(FH,$buffer,$read) != $read);
0296     }
0297     while ($size > 0 && ($read = read(STDIN,$buffer,$size)) > 0) {
0298 #print DEBUG "$size left, $read read\n";
0299         $size -= $read;
0300         $error ||= $! if (syswrite(FH,$buffer,$read) != $read);
0301     }
0302     close(FH);
0303     if (!$error) {
0304         print "### 200\n";
0305     } else {
0306         print "### 500 $error\n";
0307     }
0308 }
0309
0310 sub unquote { $_ = shift; s/\\(.)/$1/g; return $_; }
0311
0312 sub filetype {
0313     my ($mode,$link,$uid,$gid) = @_;
0314     my $result = 'P';
0315     while (1) {
0316         -f _ && do { $result .= '-'; last; };
0317         -d _ && do { $result .= 'd'; last; };
0318         defined($link) && do { $result .= 'l'; last; };
0319         -c _ && do { $result .= 'c'; last; };
0320         -b _ && do { $result .= 'b'; last; };
0321         -S _ && do { $result .= 's'; last; };
0322         -p _ && do { $result .= 'p'; last; };
0323         $result .= '?'; last;
0324     }
0325     $result .= ($mode & 0400?'r':'-');
0326     $result .= ($mode & 0200?'w':'-');
0327     $result .= ($mode & 0100?($mode&04000?'s':'x'):($mode&04000?'S':'-'));
0328     $result .= ($mode & 0040?'r':'-');
0329     $result .= ($mode & 0020?'w':'-');
0330     $result .= ($mode & 0010?($mode&02000?'s':'x'):($mode&02000?'S':'-'));
0331     $result .= ($mode & 0004?'r':'-');
0332     $result .= ($mode & 0002?'w':'-');
0333     $result .= ($mode & 0001?($mode&01000?'t':'x'):($mode&01000?'T':'-'));
0334
0335     $result .= ' ';
0336     $result .= (getpwuid($uid)||$uid);
0337     $result .= ':';
0338     $result .= (getgrgid($gid)||$gid);
0339     $result .= "\n";
0340     return $result;
0341 }
0342
0343 sub mimetype {
0344     my $fn = shift;
0345     return "Minode/directory\n" if -d $fn;
0346     pipe(IN,OUT);
0347     my $pid = fork();
0348     return '' if (!defined $pid);
0349     if ($pid) {
0350         close(OUT);
0351         my $type = <IN>;
0352         close(IN);
0353         chomp $type;
0354         chomp $type;
0355         $type =~ s/[,; ].*//;
0356         return '' if ($type !~ m/\//);
0357         return "M$type\n"
0358     }
0359     close(IN);
0360     sysopen(NULL,'/dev/null',O_RDWR);
0361     dup2(fileno(NULL),fileno(STDIN));
0362     dup2(fileno(OUT),fileno(STDOUT));
0363     dup2(fileno(NULL),fileno(STDERR));
0364     exec('/usr/bin/file','-i','-b','-L',$fn);
0365     exit(0);
0366 }
0367 __END__