1 #!/usr/bin/env retro
2 
3 ~~~
4 '\r\n s:format 'CRLF s:const
5 :vgi:user-input     '10_🔁_Text:         CRLF s:append s:put #0 unix:exit ;
6 :vgi:not-found      '51_Not_found        CRLF s:append s:put #0 unix:exit ;
7 :vgi:bad-request    '59_Bad_request      CRLF s:append s:put #0 unix:exit ;
8 :vgi:tmp-failure    '40_Unexpected_error CRLF s:append s:put #0 unix:exit ;
9 ~~~
10 
11 Разбираем запрашиваемый URL из стандратного потока ввода:
12 * всё, что до /gtransl/ слева отбрасываем вместе с этим компонентом пути;
13 * следующий компонент пути - исходный язык (константа SL);
14 * следующий компонент пути - целевой язык перевода (константа TL);
15 * если входной URL закончен, то нужно выдать пользователю запрос на ввод переводимой строки;
16 * последним извлекаем query строку с текстом, который требуется перевести (константа QUERY).
17 ~~~
18 :cut-required-path  (s-s)
19     dup '/gtransl/ s:index/string dup n:negative? [ vgi:not-found ] if
20     over s:length swap - '/gtransl/ s:length - #1 - s:right
21 ;
22 :drop-fist-char     (s-s)   dup s:length #1 - s:right ;
23 :extract-path-part  (ss-s)
24     swap dup $/ s:index/char n:negative? [ vgi:not-found ] if
25     $/ s:split/char rot s:const
26     drop-fist-char
27 ;
28 :user-input? dup s:length n:zero? [ vgi:user-input ] if ;
29 :required-query     (s-s)   dup #0 s:fetch $? -eq? [ vgi:not-found ] if ;
30 :extract-query      (s-)    required-query drop-fist-char 'QUERY s:const ;
31 s:get
32     cut-required-path 'SL extract-path-part 'TL extract-path-part 
33     user-input? 
34     extract-query
35 ~~~
36 
37 Проверяем валидность содержимого строк, 
38 что бы исключить возможность исполнения произвольной команды.
39 (Command Injection)
40 ~~~
41 :check-lang  (s-) [ $a $z n:between? [ vgi:not-found ] -if ] s:for-each ;
42 SL check-lang
43 TL check-lang
44 
45 :check-query  (s-) 
46     [ 
47         dup $a $z n:between?    [ drop ] if; 
48         dup $A $Z n:between?    [ drop ] if; 
49         dup $0 $9 n:between?    [ drop ] if; 
50         dup $% eq?              [ drop ] if;
51         dup $/ eq?              [ drop ] if;
52         dup $_ eq?              [ drop ] if;
53         dup $. eq?              [ drop ] if;
54         dup $- eq?              [ drop ] if;
55             $~ eq?              [ ] if;
56         vgi:bad-request
57     ] s:for-each
58 ;
59 QUERY check-query
60 ~~~
61 
62 Результат выполнения команды curl будем хранить в буфере из 16-ти килоячеек
63 (+ ячейка для ASCII:NULL)
64 ~~~
65 :html:BUFFER_SIZE #16384 ;
66 'html:Buffer d:create html:BUFFER_SIZE #1 + allot
67 ~~~
68 
69 Для выполнения HTTPS-запроса используем curl или (для тестов) cat из существующего файла с HTML-ответом.
70 Чтение результата выполнения команды curl по переданному описателю пайпа происходит до чтения 
71 0 символа (не байта). Считаем, что в этом случае пайп закрыт другой стороной.
72 ~~~
73 :html:read-buffer    (h-h)
74     html:Buffer buffer:set html:BUFFER_SIZE [ dup file:read/c 0; buffer:add ] times
75 ;
76 :html:pipe-command-curl      (-s)
77     QUERY TL SL 'curl_-m_5_-s_--url-query_sl=%s_--url-query_tl=%s_"https://translate.google.com/m?q=%s" s:format
78 ;
79 :html:pipe-command           (-s)
80     'GTRANSLRESPFILE s:empty [ unix:getenv ] sip dup s:length n:zero? 
81     [ drop html:pipe-command-curl ] [ 'cat_%s s:format ] choose
82 ;
83 :html:do-request
84     html:pipe-command file:R unix:popen html:read-buffer unix:pclose
85 ;
86 ~~~
87 
88 Рабоче-крестьянский парсинг HTML: 
89 извлекаем текст из тэга <div class="result-container">ИЗВЛЕКИ ЭТОТ ТЕКСТ</div>
90                                    ^(1)              ^(2)               ^(3)
91 * (1) находим подстроку "result-container"
92 * (2) вслед за ней находит символ > (могут быть пробельные символы или другие атрибуты элемента)
93 * (3) и извлекаем все, до следующего символа открывающего тэга (<)
94 
95 Затем в результате заменяем наиболее часто-используемые escape-последовательности HTML на символы.
96 ~~~
97 :html:get-result-container  (-s) 
98     html:do-request
99 
100     html:Buffer '"result-container" s:index/string dup n:negative? [ vgi:tmp-failure ] if
101     html:Buffer s:length swap - html:Buffer swap s:right
102 
103     dup $> s:index/char dup n:negative? [ vgi:tmp-failure ] if
104     swap dup s:length rot - s:right
105 
106     dup $< s:index/char #1 - #1 swap s:substr
107 
108     '&amp;  '& s:replace-all '&#38; '& s:replace-all '&#x26; '& s:replace-all
109     '&lt;   '< s:replace-all '&#60; '< s:replace-all '&#x3C; '< s:replace-all '&#x3c; '< s:replace-all
110     '&gt;   '> s:replace-all '&#62; '> s:replace-all '&#x3E; '> s:replace-all '&#x3e; '> s:replace-all
111     '&quot; '" s:replace-all '&#34; '" s:replace-all '&#x22; '" s:replace-all
112     '&apos; '' s:replace-all '&#39; '' s:replace-all '&#x27; '' s:replace-all
113 ;
114 ~~~
115 
116 Отдаём результат в формате "text/gemini" в стандартный поток вывода
117 ~~~
118 html:get-result-container
119 '20_text/gemini CRLF s:append s:put
120 '#_🔁_GTransl CRLF s:append s:put
121 CRLF s:put
122 CRLF SL 'From:_%s%s s:format s:put
123 CRLF TL 'To:___%s%s s:format s:put
124 CRLF s:put
125 '``` CRLF s:append s:put
126 (s-) CRLF s:append s:put
127 '``` CRLF s:append s:put
128 ~~~