1# ex:ts=8 sw=4: 2# $OpenBSD: SCP.pm,v 1.31 2023/06/13 09:07:18 espie Exp $ 3# 4# Copyright (c) 2003-2006 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use v5.36; 19 20use OpenBSD::PackageRepository::Persistent; 21 22package OpenBSD::PackageRepository::SCP; 23our @ISA=qw(OpenBSD::PackageRepository::Persistent); 24 25use IPC::Open2; 26use IO::Handle; 27use OpenBSD::Paths; 28 29sub urlscheme($) 30{ 31 return 'scp'; 32} 33 34# Any SCP repository uses one single connection, reliant on a perl at end. 35# The connection starts by xfering and firing up the `distant' script. 36sub initiate($self) 37{ 38 my ($rdfh, $wrfh); 39 40 $self->{controller} = open2($rdfh, $wrfh, OpenBSD::Paths->ssh, 41 $self->{host}, 'perl', '-x'); 42 $self->{cmdfh} = $wrfh; 43 $self->{getfh} = $rdfh; 44 $wrfh->autoflush(1); 45 while(<DATA>) { 46 # compress script a bit 47 next if m/^\#/o && !m/^\#!/o; 48 s/^\s*//o; 49 next if m/^$/o; 50 print $wrfh $_; 51 } 52 seek(DATA, 0, 0); 53} 54 551; 56__DATA__ 57# Distant connection script. 58#! /usr/bin/perl 59 60use v5.36; 61my $pid; 62my $token = 0; 63$|= 1; 64 65sub batch($code) 66{ 67 if (defined $pid) { 68 waitpid($pid, 0); 69 undef $pid; 70 } 71 $token++; 72 $pid = fork(); 73 if (!defined $pid) { 74 say "ERROR: fork failed: $!"; 75 } 76 if ($pid == 0) { 77 &$code(); 78 exit(0); 79 } 80} 81 82sub abort_batch() 83{ 84 if (defined $pid) { 85 kill 1, $pid; 86 waitpid($pid, 0); 87 undef $pid; 88 } 89 say "\nABORTED $token"; 90} 91 92my $dirs = {}; 93 94sub expand_tilde($arg) 95{ 96 return $dirs->{$arg} //= (getpwnam($arg))[7]."/"; 97} 98 99while (<STDIN>) { 100 chomp; 101 if (m/^LIST\s+(.*)$/o) { 102 my $dname = $1; 103 $dname =~ s/^\/\~(.*?)\//expand_tilde($1)/e; 104 batch(sub() { 105 my $d; 106 if (opendir($d, $dname)) { 107 print "SUCCESS: directory $dname\n"; 108 } else { 109 print "ERROR: bad directory $dname $!\n"; 110 } 111 while (my $e = readdir($d)) { 112 next if $e eq '.' or $e eq '..'; 113 next unless $e =~ m/(.+)\.tgz$/; 114 next unless -f "$dname/$e"; 115 print "$1\n"; 116 } 117 print "\n"; 118 closedir($d); 119 }); 120 } elsif (m/^GET\s+(.*)$/o) { 121 my $fname = $1; 122 $fname =~ s/^\/\~(.*?)\//expand_tilde($1)/e; 123 batch(sub() { 124 if (open(my $fh, '<', $fname)) { 125 my $size = (stat $fh)[7]; 126 print "TRANSFER: $size\n"; 127 my $buffer = ''; 128 while (read($fh, $buffer, 1024 * 1024) > 0) { 129 print $buffer; 130 } 131 close($fh); 132 } else { 133 print "ERROR: bad file $fname $!\n"; 134 } 135 }); 136 } elsif (m/^BYE$/o) { 137 exit(0); 138 } elsif (m/^ABORT$/o) { 139 abort_batch(); 140 } else { 141 print "ERROR: Unknown command\n"; 142 } 143} 144__END__ 145