Finished upload.pm, fixed cpanfile + bootstrap.sh

* Переименован конфиг
* Исправлены cpanfile и bootstrap.shб теперь они работают
* loadConf и saveConf перемещены в conf.pm из myapi.psgi
* Исправлен синтаксис README.md согласно форматированию GitHub
* Обновлён .gitignore
* Закончена работа над upload.pm

.gitignore

@@ -1 +1,2 @@
 vendor_perl/**
+data/myapi.json

README.md

@@ -1,31 +1,46 @@
-### Что это?
+# MyAPI
-myapi - разнообразное api и пример его использования. Api написано на perl-е для удобства и простоты разработки.
 
-### Что умеет?
+## Что это такое
+
+myapi - разнообразное api и пример его использования. Api написано на perl-е
+для удобства и простоты разработки.
+
+## Что оно умеет
+
+### ping.pm
 
-#### ping.pm
 отвечает pong, нужно для проверки, что приложение в принципе живо
 
-#### easter_egg.pm
+### easter_egg.pm
+
 ditto, пробсто бесполезные функции, just for fun
-quote - цитата дня
+quote - цитата дня (использует системную fortune)
 chanserv - обращение к несуществующему chanserv
 nickserv - обращение у несуществующему nickserv
 me - действие /me
 
-#### image_dl.pm
+### image_dl.pm
+
 будет модуль для скачивания картинок из интернетов
 
-#### metagen.pm
+### metagen.pm
+
 будет модуль для генерации метаданных в указанном репозитории
+для начала предполагается генерация метаданных для slackware linux, впрочем
+от расширения списков репозиториев меня удерживает только лень :)
 
-#### upload.pm
+### upload.pm
-модуль-пример для загрузки файлов в каталог, конфигурируется в myapi.json в классе upload.
+
+модуль для загрузки файлов в каталог, конфигурируется в myapi.json в классе
+upload. Загрузка происходит через метод PUT в процессе используется каcтомный
+заголовок auth.
+
+### paste.pm
 
-#### paste.pm
 будет модуль для пасты и для сокращения ссылок
 
-#### utils.pm
+### utils.pm
+
 модуль с простыми утилитами
 ip - возвращает ip, с которого пришёл клиент
 getaddrbyname - возвращает список ipv4 адресов по имени хоста
@@ -34,33 +49,53 @@ punycoder - кодирует в punycode
 punydecoder - превращает punycode-строку в utf-8 строку
 mytime - возвращает время
 
-#### ircbot.pm
+### ircbot.pm
+
 будет модуль с простым ботом
 
-#### xmppbot.pm
+### xmppbot.pm
+
 будет модуль с простым xmpp-ботом
 
-### Зачем это?
+## Зачем это?
+
 ХЗ, если есть что-то интересное в наборе модулей, то можно это использовать
 
-### Подготовка к запуску
+## Подготовка к запуску
-#### Сервер приложений
-Для запуска api используется uwsgi. Возможен вариант запуска и через другие сервера psgi, например, через plack или nginx unit, но это не тестировалось.
 
-#### Перловые модули
+### Сервер приложений
-Помимо самого perl-а, для запуска нужны cpanm и lib::local, чтобы имет возможность засосать всё остальное в каталог vendor_perl.
 
-#### Подготовительные операции
+Для запуска api используется uwsgi. Возможен вариант запуска и через другие
-Перед первым запуском и после каждого обновления необходимо запускать bootstrap.sh, который и засасывает зависимости из интернетов и складывает их все в каталог vendor_perl.
+сервера psgi, например, через plack или nginx unit, но это не тестировалось.
 
-Зависимостей сравнительно много и среди них есть "пидорские", но вполне себе стабильные модули, подтягиваемые по графу зависимостей не напрямую :)
+### Перловые модули
+
+Помимо самого perl-а, для запуска нужны cpanm и lib::local, чтобы иметь
+возможность засосать всё остальное в каталог vendor_perl.
+
+### Подготовительные операции
+
+Перед первым запуском и после каждого обновления необходимо запускать
+bootstrap.sh, который и засасывает зависимости из интернетов и складывает
+их все в каталог vendor_perl.
+
+Зависимостей сравнительно много и среди них есть "пидорские", но вполне себе
+стабильные модули, подтягиваемые по графу зависимостей не напрямую :)
+
+### Рабочий каталог и данные
+API работает непосредственно в том каталоге, где лежит myapi.psgi.
+
+Конфигурация самого api и модулей хранится в каталоге data, там же хранится
+состояние модулей, которые подразумевают хранение таковых данных.
+
+### Конфигурация uWSGI
 
-#### Конфигурация uWSGI
 TBD
 
-### Запуск
+## Запуск
-В процессе работы api, данные складываются в каталог data.
+
 TBD
 
-### Отанов
+## Останов
+
 TBD

bootstrap.sh

@@ -1,3 +1,3 @@
 #!/bin/bash
 
-cpanm -l vendor_perl Plack
+cpanm -l vendor_perl --force --installdeps .

cpanfile

@@ -0,0 +1,7 @@
+requires 'local::lib';
+requires 'Plack';
+requires 'Net::Jabber::Bot';
+requires 'Net::IRC';
+requires 'HTTP::Tiny';
+requires 'IO::Socket::SSL';
+requires 'Hailo';

data/myapi.json.sample

@@ -7,7 +7,9 @@
         "sleep" : 10
     },
     "upload" : {
-        "dir" : "/tmp/upload",
+        "dir" : {
+            "mydir" : "/tmp/upload",
+        },
         "auth": "iliveoncemore"
     }
 }

lib/conf.pm

@@ -0,0 +1,35 @@
+package conf;
+
+use strict;
+use warnings "all";
+use diagnostics;
+use vars qw/$VERSION/;
+use JSON::PP;
+
+use Exporter qw(import);
+our @EXPORT = qw(loadConf saveConf);
+
+$VERSION = "1.0";
+
+sub loadConf() {
+	my $c = "data/myapi.json";
+	my $sep = $/;
+	$/ = '';
+	open (C, $c) or die "No conf at $c\n";
+	my $json = <C>;
+	close C;
+	return decode_json($json);
+}
+
+sub saveConf($) {
+	my $c = shift;
+	my $file = "data/myapi.json";
+	my $j = JSON::PP->new->pretty->canonical->indent_length(4);
+	my $json = $j->encode($c);
+	# TODO: make it transactional
+	open (C, ">", $file) or die "Unable to open $file\n";
+	print C $json;
+	close C;
+}
+
+1;

lib/upload.pm

@@ -19,9 +19,23 @@ sub upload {
 	my $len = shift;
 	my $name = shift;
 	my ($status, $content, $msg) = ('400', 'text/plain', "Bad Request?\n");
+	my $d;
+	($d, $name) = split(/\//, $name, 2);
+	my $match;
+	return ($status, $content, $msg) unless ($name =~ /^[A-Z|a-z|0-9|_|\-|\+]+$/);
+
+	foreach (keys(%{$c->{upload}->{dir}})) {
+		if ($d eq $_) {
+			$match = 1;
+			last;
+		}
+	}
+
+	return ($status, $content, $msg) unless($match); # incorrect destination in url
+	$name = sprintf("%s/%s", $c->{upload}->{dir}->{$d}, $name);
 
 	if ($len > 0) {
-		if (sysopen (F, sprintf("%s/%s", $c->{upload}->{dir}, $name), O_CREAT|O_TRUNC|O_WRONLY)) {
+		if (sysopen (F, $name, O_CREAT|O_TRUNC|O_WRONLY)) {
 			my $buf;
 			my $readlen = 0;
 			my $totalread = 0;
@@ -33,7 +47,13 @@ sub upload {
 
 			do {
 				$readlen = $input->read($buf, $buflen);
-				syswrite F, $buf, $readlen;
+
+				unless (defined(syswrite F, $buf, $readlen)) { # out of space?
+					close F;
+					unlink $name;
+					return ('500', $content, "An error has occured during upload: $!\n");
+				}
+
 				$totalread += $readlen;
 			} while ($readlen == $buflen);
 

myapi.psgi

@@ -1,34 +1,22 @@
 use Data::Dumper;
 use strict;
 use warnings "all";
+use diagnostics;
 use JSON::PP;
-use threads;
-use threads::shared;
 
 # my plugins
 use lib "./lib";
+use conf;
 use ping;
 use utils;
 use easter_egg;
-use image_dl;
+use upload;
-
-sub loadConf();
-sub saveConf($);
-
-sub mythread();
-
-my $main :shared = 0;
-our @images :shared;
 
 my $CONF = loadConf();
 
 if ($CONF->{api}->{prefix} eq '/') { $CONF->{api}->{prefix} = ''; }
 my $prefix = $CONF->{api}->{prefix};
 
-#unless ($main) { threads->create('__dl_thread'); }
-threads->create('dl_thread', $CONF->{image_dl}->{dir}, $CONF->{image_dl}->{sleep});
-threads->create('mythread');
-
 my $app = sub {
 	my $env = shift;
 
@@ -81,14 +69,12 @@ EOL
 		($status, $content, $msg) = nickserv();
 	} elsif ($env->{PATH_INFO} eq "$prefix/me") {
 		($status, $content, $msg) = me();
-	} elsif ($env->{PATH_INFO} eq "$prefix/image") {
-		($status, $content, $msg) = queue_image($env->{HTTP_LINK}, \@images);
 	} elsif ($env->{PATH_INFO} =~ /$prefix\/upload\/(.+)/) {
 		my $upload = $1;
 		($status, $content, $msg) = ('400', $content, "Bad Request?\n");
 
 		if (defined($env->{HTTP_AUTH}) && ($env->{HTTP_AUTH} eq $CONF->{upload}->{auth})) {
-			if (($upload !~/(\.\.|\\|\/)/) && ($upload =~ /[A-Z|a-z|0-9|_|\-|\+]/)) {
+			if ((upload !~ /\.\./) and ($upload =~ /^[A-Z|a-z|0-9|_|\-|\+|\/]+$/)) {
 				if (defined($env->{CONTENT_LENGTH}) && ($env->{CONTENT_LENGTH} > 0)) {
 					($status, $content, $msg) = upload($env->{'psgi.input'}, $env->{CONTENT_LENGTH}, $upload);
 				}
@@ -106,42 +92,6 @@ EOL
 	];
 };
 
-sub loadConf() {
-	my $c = "data/myapi.json";
-	my $sep = $/;
-	$/ = '';
-	open (C, $c) or die "No conf at $c\n";
-	my $json = <C>;
-	close C;
-	return decode_json($json);
-}
-
-sub saveConf($) {
-	my $c = shift;
-	my $file = "data/myapi.json";
-	my $j = JSON::PP->new->pretty->canonical->indent_length(4);
-	my $json = $j->encode($c);
-	# TODO: make it transactional
-	open (C, ">", $file) or die "Unable to open $file\n";
-	print C $json;
-	close C;
-}
-
-sub mythread () {
-	$main = 1;
-	threads->detach();
-
-	while (1) {
-		sleep 10;
-		push(@images, 'http://192.168.88.1/help.png');
-		open (F, ">>", '/tmp/myapi.txt');
-		print F time() . " " . join(', ', @images) . "\n";
-		close F;
-	}
-}
-
-
-
 # vim: ft=perl noet ai ts=4 sw=4 sts=4:
 __END__