Commit Diff


commit - ab0774f849402e52818306068e86265a2502bd4e
commit + 3baf066a66ed2b1b8a32d217e7b32710f1de1bca
blob - /dev/null
blob + ef6133e32665cd288f65dc489a0eb2ef4b2e6305 (mode 755)
--- /dev/null
+++ gtransl.retro
@@ -0,0 +1,119 @@
+#!/usr/bin/env retro
+
+~~~
+'\r\n s:format 'CRLF s:const
+:user-input     '10_🔁_Text: CRLF s:append s:put #0 unix:exit ;
+:not-found      '51_Not_found CRLF s:append s:put #0 unix:exit ;
+:bad-request    '59_Bad_request CRLF s:append s:put #0 unix:exit ;
+~~~
+
+Разбираем запрашиваемый URL из стандратного потока ввода:
+* всё, что до /gtransl/ слева отбрасываем вместе с этим компонентом пути;
+* следующий компонент пути - исходный язык (константа SL);
+* следующий компонент пути - целевой язык перевода (константа TL);
+* если входной URL закончен, то нужно выдать пользователю запрос на ввод переводимой строки;
+* последним извлекаем query строку с текстом, который требуется перевести (константа QUERY).
+~~~
+:cut-required-path  (s-s)
+    dup '/gtransl/ s:index/string dup n:negative? [ not-found ] if
+    over s:length swap - '/gtransl/ s:length - #1 - s:right
+;
+:drop-fist-char     (s-s)   dup s:length #1 - s:right ;
+:extract-path-part  (ss-s)
+    swap dup $/ s:index/char n:negative? [ not-found ] if
+    $/ s:split/char rot s:const
+    drop-fist-char
+;
+:user-input? dup s:length n:zero? [ user-input ] if ;
+:required-query     (s-s)   dup #0 s:fetch $? -eq? [ not-found ] if ;
+:extract-query      (s-)    required-query drop-fist-char 'QUERY s:const ;
+s:get
+    cut-required-path 'SL extract-path-part 'TL extract-path-part 
+    user-input? 
+    extract-query
+~~~
+
+Проверяем валидность содержимого строк, 
+что бы исключить возможность исполнения произвольной команды.
+(Command Injection)
+~~~
+:check-lang  (s-) [ $a $z n:between? [ not-found ] -if ] s:for-each ;
+SL check-lang
+TL check-lang
+
+:check-query  (s-) 
+    [ 
+        dup $a $z n:between?    [ drop ] if; 
+        dup $A $Z n:between?    [ drop ] if; 
+        dup $0 $9 n:between?    [ drop ] if; 
+        dup $% eq?              [ drop ] if;
+        dup $/ eq?              [ drop ] if;
+        dup $_ eq?              [ drop ] if;
+        dup $. eq?              [ drop ] if;
+        dup $- eq?              [ drop ] if;
+            $~ eq?              [ ] if;
+        bad-request
+    ] s:for-each
+;
+QUERY check-query
+~~~
+
+Результат выполнения команды curl будем хранить в буфере из 16-ти килоячеек
+(+ ячейка для ASCII:NULL)
+~~~
+:BUFFER_SIZE #16384 ;
+'Buffer d:create BUFFER_SIZE #1 + allot
+~~~
+
+Для выполнения HTTPS-запроса используем curl.
+Чтение результата выполнения команды curl по переданному описателю пайпа происходит до чтения 
+0 символа (не байта). Считаем, что в этом случае пайп закрыт другой стороной.
+~~~
+:read-curl-output  (h-) BUFFER_SIZE [ dup file:read/c 0; buffer:add ] times ;
+:do-curl
+    Buffer buffer:set
+    'CURLRESP s:empty [ unix:getenv ] sip
+    dup s:length n:zero? [
+        drop
+        QUERY TL SL 'curl_-s_--url-query_sl=%s_--url-query_tl=%s_"https://translate.google.com/m?q=%s" s:format
+        file:R unix:popen read-curl-output unix:pclose
+    ] if;
+    [ buffer:add ] s:for-each
+;
+~~~
+
+Рабоче-крестьянский парсинг HTML: 
+извлекаем текст из тэга <div class="result-container">ИЗВЛЕКИ ЭТОТ ТЕКСТ</div>
+                                   ^(1)              ^(2)               ^(3)
+* (1) находим подстроку "result-container"
+* (2) вслед за ней находит символ > (могут быть пробельные символы или другие атрибуты элемента)
+* (3) и извлекаем все, до следующего символа открывающего тэга (<)
+
+Затем в результате заменяем наиболее часто-используемые escape-последовательности HTML на символы.
+~~~
+:extract-result-container  (s-s) 
+    '"result-container" s:split/string drop
+    $> s:split/char drop
+    dup $< s:index/char #1 - #1 swap s:substr
+
+    '&amp;  '& s:replace-all '&#38; '& s:replace-all '&#x26; '& s:replace-all
+    '&lt;   '< s:replace-all '&#60; '< s:replace-all '&#x3C; '< s:replace-all '&#x3c; '< s:replace-all
+    '&gt;   '> s:replace-all '&#62; '> s:replace-all '&#x3E; '> s:replace-all '&#x3e; '> s:replace-all
+    '&quot; '" s:replace-all '&#34; '" s:replace-all '&#x22; '" s:replace-all
+    '&apos; '' s:replace-all '&#39; '' s:replace-all '&#x27; '' s:replace-all
+;
+~~~
+
+Отдаём результат в формате "text/gemini" в стандартный поток вывода
+~~~
+do-curl buffer:start extract-result-container
+'20_text/gemini CRLF s:append s:put
+'#_🔁_GTransl CRLF s:append s:put
+CRLF s:put
+CRLF SL 'From:_%s%s s:format s:put
+CRLF TL 'To:___%s%s s:format s:put
+CRLF s:put
+'``` CRLF s:append s:put
+(s-) CRLF s:append s:put
+'``` CRLF s:append s:put
+~~~
blob - /dev/null
blob + 297fd45b2a2a2a466021ce0e1228e39d3bc6f18d (mode 755)
--- /dev/null
+++ tests.sh
@@ -0,0 +1,49 @@
+#!/bin/sh
+
+echo "Not found tests..."
+echo "gemini://any-key.press/vgi" | ./gtransl.retro | head -n 1 | \
+    grep "^51 Not found" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl" | ./gtransl.retro | \
+    grep "^51 Not found" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/" | ./gtransl.retro | \
+    head -n 1 | grep "^51 Not found" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransX/auto/ru/?hello" | ./gtransl.retro | head -n 1 | \
+    grep "^51 Not found" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/?\" ; ls/ru/?hello" | ./gtransl.retro | head -n 1 | \
+    grep "^51 Not found" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/auto/?\" ; ls/?hello" | ./gtransl.retro | head -n 1 | \
+    grep "^51 Not found" > /dev/null && echo "passed" || echo "FAILED"
+
+echo "Bad request tests..."
+echo "gemini://any-key.press/vgi/gtransl/auto/ru/?\" ; ls" | ./gtransl.retro | head -n 1 | \
+    grep "^59 Bad request" > /dev/null && echo "passed" || echo "FAILED"
+
+echo "Escaping tests..."
+echo "gemini://any-key.press/vgi/gtransl/sl/tl/?query" | \
+    CURLRESP="<div class=\"result-container\">amp=&amp; lt=&lt; gt=&gt; quot=&quot; apos=&apos;</div>" ./gtransl.retro | \
+    head -n 8 | tail -n 1 | \
+    grep "^amp=& lt=< gt=> quot=\" apos='" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/sl/tl/?query" | \
+    CURLRESP="<div class=\"result-container\">amp=&#38; lt=&#60; gt=&#62; quot=&#34; apos=&#39;</div>" ./gtransl.retro | \
+    head -n 8 | tail -n 1 | \
+    grep "^amp=& lt=< gt=> quot=\" apos='" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/sl/tl/?query" | \
+    CURLRESP="<div class=\"result-container\">amp=&#x26; lt=&#x3C; gt=&#x3E; quot=&#x22; apos=&#x27;</div>" ./gtransl.retro | \
+    head -n 8 | tail -n 1 | \
+    grep "^amp=& lt=< gt=> quot=\" apos='" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/sl/tl/?query" | \
+    CURLRESP="<div class=\"result-container\">lt=&#x3c; gt=&#x3e;</div>" ./gtransl.retro | \
+    head -n 8 | tail -n 1 | \
+    grep "^lt=< gt=>" > /dev/null && echo "passed" || echo "FAILED"
+
+echo "Multiline tests..."
+echo "gemini://any-key.press/vgi/gtransl/sl/tl/?query" | \
+    CURLRESP="<div class=\"result-container\">hello
+world</div>" ./gtransl.retro | \
+    head -n 8 | tail -n 1 | \
+    grep "^hello$" > /dev/null && echo "passed" || echo "FAILED"
+echo "gemini://any-key.press/vgi/gtransl/sl/tl/?query" | \
+    CURLRESP="<div class=\"result-container\">hello
+world</div>" ./gtransl.retro | \
+    head -n 9 | tail -n 1  | \
+    grep "^world" > /dev/null && echo "passed" || echo "FAILED"