1# ex:ts=8 sw=4:
2# $OpenBSD: SCP.pm,v 1.29 2014/08/27 18:40:03 kspillner 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 strict;
19use warnings;
20
21use OpenBSD::PackageRepository::Persistent;
22
23package OpenBSD::PackageRepository::SCP;
24our @ISA=qw(OpenBSD::PackageRepository::Persistent);
25
26use IPC::Open2;
27use IO::Handle;
28use OpenBSD::Paths;
29
30sub urlscheme
31{
32	return 'scp';
33}
34
35# Any SCP repository uses one single connection, reliant on a perl at end.
36# The connection starts by xfering and firing up the `distant' script.
37sub initiate
38{
39	my $self = shift;
40
41	my ($rdfh, $wrfh);
42
43	$self->{controller} = open2($rdfh, $wrfh, OpenBSD::Paths->ssh,
44	    $self->{host}, 'perl', '-x');
45	$self->{cmdfh} = $wrfh;
46	$self->{getfh} = $rdfh;
47	$wrfh->autoflush(1);
48	while(<DATA>) {
49		# compress script a bit
50		next if m/^\#/o && !m/^\#!/o;
51		s/^\s*//o;
52		next if m/^$/o;
53		print $wrfh $_;
54	}
55	seek(DATA, 0, 0);
56}
57
581;
59__DATA__
60# Distant connection script.
61#! /usr/bin/perl
62
63my $pid;
64my $token = 0;
65$|= 1;
66
67sub batch(&)
68{
69	my $code = shift;
70	if (defined $pid) {
71		waitpid($pid, 0);
72		undef $pid;
73	}
74	$token++;
75	$pid = fork();
76	if (!defined $pid) {
77		print "ERROR: fork failed: $!\n";
78	}
79	if ($pid == 0) {
80		&$code();
81		exit(0);
82	}
83}
84
85sub abort_batch()
86{
87	if (defined $pid) {
88		kill 1, $pid;
89		waitpid($pid, 0);
90		undef $pid;
91	}
92	print "\nABORTED $token\n";
93}
94
95my $dirs = {};
96
97sub expand_tilde
98{
99	my $arg = shift;
100
101	return $dirs->{$arg} //= (getpwnam($arg))[7]."/";
102}
103
104while (<STDIN>) {
105	chomp;
106	if (m/^LIST\s+(.*)$/o) {
107		my $dname = $1;
108		$dname =~ s/^\/\~(.*?)\//expand_tilde($1)/e;
109		batch(sub {
110			my $d;
111			if (opendir($d, $dname)) {
112				print "SUCCESS: directory $dname\n";
113			} else {
114				print "ERROR: bad directory $dname $!\n";
115			}
116			while (my $e = readdir($d)) {
117				next if $e eq '.' or $e eq '..';
118				next unless $e =~ m/(.+)\.tgz$/;
119				next unless -f "$dname/$e";
120				print "$1\n";
121			}
122			print "\n";
123			closedir($d);
124		});
125	} elsif (m/^GET\s+(.*)$/o) {
126		my $fname = $1;
127		$fname =~ s/^\/\~(.*?)\//expand_tilde($1)/e;
128		batch(sub {
129			if (open(my $fh, '<', $fname)) {
130				my $size = (stat $fh)[7];
131				print "TRANSFER: $size\n";
132				my $buffer = '';
133				while (read($fh, $buffer, 1024 * 1024) > 0) {
134					print $buffer;
135				}
136				close($fh);
137			} else {
138				print "ERROR: bad file $fname $!\n";
139			}
140		});
141	} elsif (m/^BYE$/o) {
142		exit(0);
143	} elsif (m/^ABORT$/o) {
144		abort_batch();
145	} else {
146		print "ERROR: Unknown command\n";
147	}
148}
149__END__
150