Пишем свой веб-сервер на Perl под Android

23 апреля 2011 г.

Сегодня мы с Вами напишем свой собственный веб-сервер на Perl. Что, говорите что этим уже никого не удивишь? А если я скажу, что запустим мы его под Android?

С помощью этого сервера Вы сможете легко обеспечить доступ всех желающих к определённым файлам карты памяти Вашего телефона.
Например, Вы пришли к друзьям в гости и хотите показать новые фотографии с телефона, но кабеля под рукой нет, а смотреть фотографии с телефона не удобно. В таком случае можно будет с компьютера обратиться к веб-серверу и он отдаст нам фотографии.
Ещё, таким же способом можно показывать макет сайта заказчику.

Всех, кому это кажется интересным, проку под кат.

При написании любого скрипта под Android краеугольным камнем является Android Scripting Environment (ASE). Это система от разработчиков Android, с помощью которой можно исполнять скрипты на нескольких языках ( Python, Perl, JRuby, Lua, BeanShell, JavaScript, Tcl и shell ) прямо на телефоне. Скрипты ASE, посредством различных API, позволяют совершать звонки, отправлять текстовых сообщений, сканировать штрих-коды, преобразовать текст в речь и т.д.
Сначала ставим ASE и Perl.

ставим ASE и Perl

Запускаем test.pl чтобы проверить что всё работает.

Запускаем 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, автоматически формируется галерея.

плагин lightbox

На этом всё, спасибо за внимание. Надеюсь Вы получили удовольствие от прочтения.

Теги:
рубрика Android, Интернет
  • Похожие статьи
  • Предыдущие из рубрики