Пишем свой веб-сервер на Perl под Android
Сегодня мы с Вами напишем свой собственный веб-сервер на Perl. Что, говорите что этим уже никого не удивишь? А если я скажу, что запустим мы его под Android?
С помощью этого сервера Вы сможете легко обеспечить доступ всех желающих к определённым файлам карты памяти Вашего телефона.
Например, Вы пришли к друзьям в гости и хотите показать новые фотографии с телефона, но кабеля под рукой нет, а смотреть фотографии с телефона не удобно. В таком случае можно будет с компьютера обратиться к веб-серверу и он отдаст нам фотографии.
Ещё, таким же способом можно показывать макет сайта заказчику.
Всех, кому это кажется интересным, проку под кат.
При написании любого скрипта под Android краеугольным камнем является Android Scripting Environment (ASE). Это система от разработчиков Android, с помощью которой можно исполнять скрипты на нескольких языках ( Python, Perl, JRuby, Lua, BeanShell, JavaScript, Tcl и shell ) прямо на телефоне. Скрипты ASE, посредством различных API, позволяют совершать звонки, отправлять текстовых сообщений, сканировать штрих-коды, преобразовать текст в речь и т.д.
Сначала ставим ASE и Perl.
Запускаем test.pl чтобы проверить что всё работает.
Теперь приступим к написанию кода:
use warnings;
use strict;
use Socket;
use IO::Socket;
# Конфигурация сервера
my $port = 3000;
my $root = '/mnt/sdcard';
# Создаём сокет
my $server = new IO::Socket::INET(
Proto => 'tcp',
LocalPort => $port,
Listen => SOMAXCONN,
Reuse => 1
) or die 'Unable to create server socket!' ;
print "Server available at http://localhost:$port/\n";
# Ожидаем подключение
while (my $client = $server->accept()) {
$client->autoflush(1);
# Разбираем запрос
my ($method, $uri, $html_version) = split /\s/, <$client>;
# Отсекаем GET-параметры
$uri =~ s/\?.*$//;
# unescape
$uri =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
# Запрашиваемый файл
my $path = "$root$uri";
if (-e $path) { # Есть что отдать
if (-f $path) { # Это файл
if (-r $path) { # Есть права на чтение
# По расширению определяем content-type
my ($ext) = $uri =~ /\.(\w+)$/;
my $type = mime_type($ext);
print $client http_headers('200 OK', $type);
# Отдаём файл
open FILE, "<$path";
while ( read FILE, my $buffer, 1024 ) { print $client $buffer }
close FILE;
} else { # Нет прав на чтение
# Отдаём ошибку 403
print $client http_headers('403 Forbidden');
print $client '<html><head><title>403 Forbidden</title></head><body>403 Forbidden (Запрещено)</body></html>';
}
} else { # Это каталог
if (-r $path) { # Есть права на чтение, отдаём список фалов
print $client http_headers('200 OK');
print $client <<HTML;
<html>
<head>
<title>Файлы каталога $uri</title>
<meta content="text/html; charset=utf-8" http-equiv="Content-Type">
<meta name="viewport" content="width=device-width; initial-scale=1.0; maximum-scale=1.0; user-scalable=0;"/>
<link href="/perlonandroid/css/style.css" type="text/css" rel="stylesheet" media="screen" />
<link href="/perlonandroid/css/lightbox.css" type="text/css" rel="stylesheet" media="screen" />
<script src="/perlonandroid/js/jquery.js" type="text/javascript"></script>
<script src="/perlonandroid/js/lightbox.js" type="text/javascript"></script>
<script src="/perlonandroid/js/script.js" type="text/javascript"></script>
</head>
<body>
<div id="head">
<div>Perl On Android</div>
<div class="clear"></div>
</div>
HTML
# Кастомный алгоритм сортировки. Каталоги выше файлов
sub mysort {
if (-d "$path$a") {
-d "$path$b" ? lc$a cmp lc$b : -1
} else {
-d "$path$b" ? 1 : lc$a cmp lc$b
}
}
# Печатаем список файлов
opendir DIR, "$path/";
foreach my $file (sort mysort readdir DIR) {
next if $file =~ /^\.$/;
my $lightbox = '';
if (-d "$path$file") {
$file .= '/';
} else {
my ($ext) = $file =~ /\.(\w+)$/;
$lightbox = "rel=\"image\" title=\"$file\"" if mime_type($ext) =~ /^image/;
}
print $client "<a href=\"$file\" class=\"link\" $lightbox>$file</a>";
}
closedir DIR;
print $client '</body></html>';
} else { # Нет прав на чтение
# Отдаём ошибку 403
print $client http_headers('403 Forbidden');
print $client '<html><head><title>403 Forbidden</title></head><body>403 Forbidden (Запрещено)</body></html>';
}
}
} else { # Файл не найден
# Отдаём ошибку 404
print $client http_headers('404 Not Found');
print $client '<html><head><title>404 Not Found</title></head><body>404 Not Found (Не найдено)</body></html>'
}
# Закрываем поток
close $client;
# Выводим сообщение
print "$method $uri\n";
}
# Формируем HTTP заголовок
sub http_headers {
my ($status, $type) = @_;
$type ||= 'text/html; charset=UTF-8';
return <<RESPONSE;
HTTP/1.0 $status
Server: PerlOnAndroid
Content-type: $type
Connection: close
RESPONSE
}
# get MIME types
sub mime_type {
my ($ext) = @_;
return '' unless defined $ext;
return {
'html' => 'text/html',
'htm' => 'text/html',
'shtml' => 'text/html',
'css' => 'text/css',
'xml' => 'text/xml',
'rss' => 'text/xml',
'gif' => 'image/gif',
'jpeg' => 'image/jpeg',
'jpg' => 'image/jpeg',
'js' => 'application/x-javascript',
'atom' => 'application/atom+xml',
'mml' => 'text/mathml',
'txt' => 'text/plain',
'jad' => 'text/vnd.sun.j2me.app-descriptor',
'wml' => 'text/vnd.wap.wml',
'htc' => 'text/x-component',
'png' => 'image/png',
'tif' => 'image/tiff',
'tiff' => 'image/tiff',
'wbmp' => 'image/vnd.wap.wbmp',
'ico' => 'image/x-icon',
'jng' => 'image/x-jng',
'bmp' => 'image/x-ms-bmp',
'jar' => 'application/java-archive',
'war' => 'application/java-archive',
'ear' => 'application/java-archive',
'hqx' => 'application/mac-binhex40',
'doc' => 'application/msword',
'pdf' => 'application/pdf',
'ps' => 'application/postscript',
'eps' => 'application/postscript',
'ai' => 'application/postscript',
'rtf' => 'application/rtf',
'xls' => 'application/vnd.ms-excel',
'ppt' => 'application/vnd.ms-powerpoint',
'wmlc' => 'application/vnd.wap.wmlc',
'xhtml' => 'application/vnd.wap.xhtml+xml',
'cco' => 'application/x-cocoa',
'jnlp' => 'application/x-java-jnlp-file',
'run' => 'application/x-makeself',
'pl' => 'application/x-perl',
'pm' => 'application/x-perl',
'prc' => 'application/x-pilot',
'pdb' => 'application/x-pilot',
'rar' => 'application/x-rar-compressed',
'rpm' => 'application/x-redhat-package-manager',
'sea' => 'application/x-sea',
'swf' => 'application/x-shockwave-flash',
'sit' => 'application/x-stuffit',
'tcl' => 'application/x-tcl',
'tk' => 'application/x-tcl',
'der' => 'application/x-x509-ca-cert',
'pem' => 'application/x-x509-ca-cert',
'crt' => 'application/x-x509-ca-cert',
'xpi' => 'application/x-xpinstall',
'zip' => 'application/zip',
'bin' => 'application/octet-stream',
'exe' => 'application/octet-stream',
'dll' => 'application/octet-stream',
'deb' => 'application/octet-stream',
'dmg' => 'application/octet-stream',
'eot' => 'application/octet-stream',
'iso' => 'application/octet-stream',
'img' => 'application/octet-stream',
'msi' => 'application/octet-stream',
'msp' => 'application/octet-stream',
'msm' => 'application/octet-stream',
'mid' => 'audio/midi',
'midi' => 'audio/midi',
'kar' => 'audio/midi',
'mp3' => 'audio/mpeg',
'ra' => 'audio/x-realaudio',
'3gpp' => 'video/3gpp',
'3gp' => 'video/3gpp',
'mpeg' => 'video/mpeg',
'mpg' => 'video/mpeg',
'mov' => 'video/quicktime',
'flv' => 'video/x-flv',
'mng' => 'video/x-mng',
'asx' => 'video/x-ms-asf',
'asf' => 'video/x-ms-asf',
'wmv' => 'video/x-ms-wmv',
'avi' => 'video/x-msvideo',
}->{lc $ext} || '';
};
Самое трудное позади! Теперь сохраняем скрипт в каталог /mnt/sdcard/sl4a/scripts. Также в корне карты памяти нужно расположить этот каталог со статикой (css, js). Теперь можно набрать в браузере телефона http://localhost:3000/ и увидеть что-то похожее на это:
Теперь все желающие могут получить доступ к файлам катры памяти вашего телефона. Из изображений, с помощью плагина lightbox, автоматически формируется галерея.
На этом всё, спасибо за внимание. Надеюсь Вы получили удовольствие от прочтения.