Blob

Date:
Message:
Fix: string overflow
Actions:
History | Blame | Raw File
1 #!/usr/bin/env retro

3 ~~~

4 '\r\n s:format 'CRLF s:const

5 :vgi:print-line     (s-) s:put CRLF s:put ;

6 :vgi:user-input     '10_Text_🔁:         vgi:print-line #0 unix:exit ;

7 :vgi:not-found      '51_Not_found        vgi:print-line #0 unix:exit ;

8 :vgi:bad-request    '59_Bad_request      vgi:print-line #0 unix:exit ;

9 :vgi:tmp-failure    '40_Unexpected_error vgi:print-line #0 unix:exit ;

10 ~~~

12 По спецификации Gemini запрашиваемый URL не может превышать 1024 байта. 

13 Поэтому на хранение URL выделяем 1024 ячеек + ячейку для терминирующего нуля.

14 ~~~

15 'url:Buffer d:create #1025 allot

16 :url:get  (-)

17     url:Buffer buffer:set 

18     #1024 [ c:get dup ASCII:CR eq? [ drop ] if; dup ASCII:LF eq? [ drop ] if; buffer:add ] times

19 ;

20 url:get

21 ~~~

23 Разбираем запрашиваемый URL из стандратного потока ввода:

24 * всё, что до /gtransl/ слева отбрасываем вместе с этим компонентом пути;

25 * следующий компонент пути - исходный язык (константа url:SL);

26 * следующий компонент пути - целевой язык перевода (константа url:TL);

27 * если входной URL закончен, то нужно выдать пользователю запрос на ввод переводимой строки;

28 * последним извлекаем query строку с текстом, который требуется перевести (константа url:QUERY).

29 ~~~

30 '/gtransl/ 'url:REQUIRED-PATH s:const

31 :url:required-path  (s-s)

32     dup url:REQUIRED-PATH s:index/string dup n:negative? [ vgi:not-found ] if

33     + url:REQUIRED-PATH s:length + n:inc

34 ;

35 :url:path-part      (ss-s)

36     swap dup $/ s:index/char dup n:negative? [ vgi:not-found ] if

37     dup @TempStringMax gteq? [ vgi:bad-request ] if

38     over over s:left 

39     rot rot + rot rot swap s:const

40     n:inc

41 ;

42 :url:check-user-input   (s-s) dup s:length n:zero? [ vgi:user-input ] if ;

43 :url:required-query     (s-s) dup fetch $? -eq? [ vgi:not-found ] if ;

44 :url:query              (s-)  url:check-user-input url:required-query n:inc 'url:QUERY const ;

46 url:Buffer url:required-path 'url:SL url:path-part 'url:TL url:path-part url:query

47 ~~~

49 Проверяем валидность содержимого строк, 

50 что бы исключить возможность исполнения произвольной команды.

51 (Command Injection)

52 ~~~

53 :url:check-lang     (s-) [ $a $z n:between? [ vgi:not-found ] -if ] s:for-each ;

54 url:SL url:check-lang

55 url:TL url:check-lang

57 :url:check-query    (s-) 

58     [ 

59         dup $a $z n:between?    [ drop ] if; 

60         dup $A $Z n:between?    [ drop ] if; 

61         dup $0 $9 n:between?    [ drop ] if; 

62         dup $% eq?              [ drop ] if;

63         dup $/ eq?              [ drop ] if;

64         dup $_ eq?              [ drop ] if;

65         dup $. eq?              [ drop ] if;

66         dup $- eq?              [ drop ] if;

67         dup $: eq?              [ drop ] if;

68             $~ eq?              [ ] if;

69         vgi:bad-request

70     ] s:for-each

71 ;

72 url:QUERY url:check-query

73 ~~~

75 Результат выполнения команды curl будем хранить в буфере из 16-ти килоячеек

76 (+ ячейка для ASCII:NULL)

77 ~~~

78 :html:BUFFER_SIZE #16384 ;

79 'html:Buffer d:create html:BUFFER_SIZE n:inc allot

80 ~~~

82 Для выполнения HTTPS-запроса используем curl или (для тестов) cat из существующего файла с HTML-ответом.

83 Чтение результата выполнения команды curl по переданному описателю пайпа происходит до чтения 

84 0 символа (не байта). Считаем, что в этом случае пайп закрыт другой стороной.

85 ~~~

86 :pipe:read          (h-h) html:Buffer buffer:set html:BUFFER_SIZE [ dup file:read/c 0; buffer:add ] times ;

87 'CurlCommand d:create #3072 allot

88 :buffer:append      (s-) [ buffer:add ] s:for-each ;

89 :pipe:command-curl  (-s)

90     CurlCommand buffer:set 

91     'curl_-m_5_-s_--url-query_sl="          buffer:append

92     url:SL                                  buffer:append

93     '"_--url-query_tl="                     buffer:append

94     url:TL                                  buffer:append

95     '"_"https://translate.google.com/m?q=   buffer:append

96     url:QUERY                               buffer:append

97     '"                                      buffer:append

98     CurlCommand

99 ;

100 :get-env            (s-s) s:empty [ unix:getenv ] sip ; 

101 :zero-length?       (s-s) dup s:length n:zero? ;

102 :pipe:command       (-s) 'GTRANSLRESPFILE get-env zero-length? [ drop pipe:command-curl ] [ 'cat_%s s:format ] choose ;

103 :pipe:request pipe:command file:R unix:popen pipe:read unix:pclose ;

104 ~~~

106 Рабоче-крестьянский парсинг HTML: 

107 извлекаем текст из тэга <div class="result-container">ИЗВЛЕКИ ЭТОТ ТЕКСТ</div>

108                                    ^(1)              ^(2)               ^(3)

109 * (1) находим подстроку "result-container"

110 * (2) вслед за ней находит символ > (могут быть пробельные символы или другие атрибуты элемента)

111 * (3) и извлекаем все, до следующего символа открывающего тэга (<)

113 Затем в результате заменяем наиболее часто-используемые escape-последовательности HTML на символы.

114 ~~~

115 :html:index/char                (sc-n) s:index/char dup n:negative? [ vgi:tmp-failure ] if ; 

116 :html:index/result-container    (s-n) '"result-container" s:index/string dup n:negative? [ vgi:tmp-failure ] if ;

117 :buffer:append-n                (sn-) [ dup I s:fetch buffer:add ] indexed-times drop ;

118 :html:cut-head                  (sn-s) over buffer:set + repeat dup fetch 0; buffer:add n:inc again ;

119 :html:unquote?                  (ssc-sf)

120     rot rot over over s:begins-with? [ drop drop drop FALSE ] -if;

121     s:length n:dec rot rot store swap dup n:inc rot html:cut-head drop TRUE

123 :html:unquote-head              (s-s)

124     dup '&amp;  $& html:unquote? [ ] if;

125     dup '&#38;  $& html:unquote? [ ] if;

126     dup '&#x26; $& html:unquote? [ ] if;

128     dup '&lt;   $< html:unquote? [ ] if;

129     dup '&#60;  $< html:unquote? [ ] if;

130     dup '&#x3C; $< html:unquote? [ ] if;

131     dup '&#x3c; $< html:unquote? [ ] if;

133     dup '&gt;   $> html:unquote? [ ] if;

134     dup '&#62;  $> html:unquote? [ ] if;

135     dup '&#x3E; $> html:unquote? [ ] if;

136     dup '&#x3e; $> html:unquote? [ ] if;

138     dup '&quot; $" html:unquote? [ ] if;

139     dup '&#34;  $" html:unquote? [ ] if;

140     dup '&#x22; $" html:unquote? [ ] if;

142     dup '&apos; $' html:unquote? [ ] if;

143     dup '&#39;  $' html:unquote? [ ] if;

144     dup '&#x27; $' html:unquote? [ ] if;

146 :html:unquote                   (s-s)

147     repeat

148         dup fetch 0; $& eq? [ html:unquote-head ] if n:inc

149     again

151 :html:get-result-container      (-s) 

152     pipe:request 

153     html:Buffer html:index/result-container html:Buffer +

154     dup $> html:index/char + n:inc

155     dup $< html:index/char

156     html:Buffer buffer:set buffer:append-n

157     html:Buffer html:unquote drop

158     html:Buffer

160 ~~~

162 Отдаём результат в формате "text/gemini" в стандартный поток вывода

163 ~~~

164 html:get-result-container (*1)

165 '20_text/gemini vgi:print-line

166 '#_GTransl_🔁 vgi:print-line

167 CRLF s:put

168 CRLF url:SL 'From:_%s%s s:format s:put

169 CRLF url:TL 'To:___%s%s s:format s:put

170 CRLF s:put

171 '``` vgi:print-line

172 (*1) vgi:print-line

173 '``` vgi:print-line

174 ~~~

176 Затираем в URL query-часть и выводим ссылку на новый запрос перевода

177 ~~~

178 #0 url:Buffer dup $? s:index/char + store

179 '=>_ s:put url:Buffer s:put '_More s:put CRLF s:put

180 ~~~