Initial commit

2020-11-29 15:18:14 +03:00
commit c3f04b6c7f
16 changed files with 1623 additions and 0 deletions
--- a/Slackmetarep/Upload.pm
+++ b/Slackmetarep/Upload.pm
@@ -0,0 +1,99 @@
+package Slackmetarep::Upload;
+
+use strict;
+use warnings;
+use vars qw/$VERSION/;
+use English qw( -no_match_vars );
+use Carp;
+
+use Fcntl;
+use Slackmetarep::Conf qw(loadConf);
+
+use Exporter qw(import);
+our @EXPORT_OK = qw(upload);
+
+$VERSION = '1.0';
+
+my $c = loadConf ();
+
+sub upload {
+	my $input = shift;        # file descriptor with data being uploaded
+	my $len = shift;          # expected data length (from client)
+	my $name = shift;         # upload "dir" and filename
+	my ($status, $content, $msg) = ('400', 'text/plain', "Bad Request?\n");
+
+	return ($status, $content, "No Content-Length supplied.\n") unless (defined $len);
+	return ($status, $content, "No name supplied.\n") unless (defined $name);
+
+	my $d;
+	($d, $name) = split (/\//xms, $name, 2);
+
+	return ($status, $content, "Name does not match pattern.\n") unless ($name =~ /^[[:alnum:]_\-\+\.]+$/xmsg);
+
+	my $match;
+
+	foreach my $uploaddir (keys(%{$c->{upload}->{dir}})) {
+		if ($d eq $uploaddir) {
+			$match = 1;
+			last;
+		}
+	}
+
+	return ($status, $content, "Incorrect destination dir.\n") unless $match; # incorrect destination in url
+
+	$name = sprintf('%s/%s', $c->{upload}->{dir}->{$d}, $name);
+
+	if ($len > 0) {
+		if (sysopen (my $FH, $name, O_CREAT|O_TRUNC|O_WRONLY)) {
+			my $buf;
+			my $readlen = 0;
+			my $totalread = 0;
+			my $buflen = 524288; # 512 kbytes, looks sane enough
+
+			if ($len < $buflen) {
+				$buflen = $len;
+			}
+
+			do {
+				$readlen = $input->read($buf, $buflen);
+
+				my $written = syswrite $FH, $buf, $readlen;
+
+				unless (defined($written)) { # out of space?
+					close $FH; ## no critic (InputOutput::RequireCheckedSyscalls)
+					unlink $name;
+					carp "[FATA] Unable to write to $name: $OS_ERROR";
+					return ('500', $content, "An error has occured during upload: $OS_ERROR\n");
+				}
+
+				if ($readlen != $written) {
+					close $FH; ## no critic (InputOutput::RequireCheckedSyscalls)
+					unlink $name;
+					carp "[FATA] Must write $readlen bytes, but actualy wrote $written bytes to $name";
+					return ('500', $content, "An error has occured during upload: $OS_ERROR\n");
+				}
+
+				$totalread += $readlen;
+			} while ($readlen == $buflen);
+
+			close $FH; ## no critic (InputOutput::RequireCheckedSyscalls)
+
+			if ($totalread != $len) {
+				($content, $msg) = ($content, "Content-Length does not match amount of recieved bytes.\n");
+			} else {
+				($status, $content, $msg) = ('201', $content, "Uploaded.\n");
+			}
+		} else {
+			carp "[FATA] Unable to open file $name: $OS_ERROR";
+			($status, $content, $msg) = ('500', $content, "Unable to write: $OS_ERROR\n");
+		}
+	} else {
+		$msg = "Incorrect Content-Length\n";
+	}
+
+	return ($status, $content, $msg);
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4 :