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