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