include "scanstri.s7i";
include "socket.s7i";
include "gzip.s7i";
include "charsets.s7i";
include "encoding.s7i";
var string: proxyServer is "";
var integer: proxyHttpPort is 0;
const integer: httpDefaultPort is 80;
const integer: httpsDefaultPort is 443;
const string: HTTP_CONTINUE is "100";
const string: HTTP_SWITCHING_PROTOCOLS is "101";
const string: HTTP_PROCESSING is "102";
const string: HTTP_EARLY_HINTS is "103";
const string: HTTP_OK is "200";
const string: HTTP_CREATED is "201";
const string: HTTP_ACCEPTED is "202";
const string: HTTP_NON_AUTHORITATIVE_INFORMATION is "203";
const string: HTTP_NO_CONTENT is "204";
const string: HTTP_RESET_CONTENT is "205";
const string: HTTP_PARTIAL_CONTENT is "206";
const string: HTTP_MULTI_STATUS is "207";
const string: HTTP_ALREADY_REPORTED is "208";
const string: HTTP_IM_USED is "226";
const string: HTTP_MULTIPLE_CHOICES is "300";
const string: HTTP_MOVED_PERMANENTLY is "301";
const string: HTTP_FOUND is "302";
const string: HTTP_SEE_OTHER is "303";
const string: HTTP_NOT_MODIFIED is "304";
const string: HTTP_USE_PROXY is "305";
const string: HTTP_SWITCH_PROXY is "306";
const string: HTTP_TEMPORARY_REDIRECT is "307";
const string: HTTP_PERMANENT_REDIRECT is "308";
const string: HTTP_BAD_REQUEST is "400";
const string: HTTP_UNAUTHORIZED is "401";
const string: HTTP_PAYMENT_REQUIRED is "402";
const string: HTTP_FORBIDDEN is "403";
const string: HTTP_NOT_FOUND is "404";
const string: HTTP_METHOD_NOT_ALLOWED is "405";
const string: HTTP_NOT_ACCEPTABLE is "406";
const string: HTTP_PROXY_AUTHENTICATION_REQUIRED is "407";
const string: HTTP_REQUEST_TIMEOUT is "408";
const string: HTTP_CONFLICT is "409";
const string: HTTP_GONE is "410";
const string: HTTP_LENGTH_REQUIRED is "411";
const string: HTTP_PRECONDITION_FAILED is "412";
const string: HTTP_CONTENT_TOO_LARGE is "413";
const string: HTTP_URI_TOO_LONG is "414";
const string: HTTP_UNSUPPORTED_MEDIA_TYPE is "415";
const string: HTTP_RANGE_NOT_SATISFIABLE is "416";
const string: HTTP_EXPECTATION_FAILED is "417";
const string: HTTP_I_AM_A_TEAPOT is "418";
const string: HTTP_MISDIRECTED_REQUEST is "421";
const string: HTTP_UNPROCESSABLE_CONTENT is "422";
const string: HTTP_LOCKED is "423";
const string: HTTP_FAILED_DEPENDENCY is "424";
const string: HTTP_TOO_EARLY is "425";
const string: HTTP_UPGRADE_REQUIRED is "426";
const string: HTTP_PRECONDITION_REQUIRED is "428";
const string: HTTP_TOO_MANY_REQUESTS is "429";
const string: HTTP_REQUEST_HEADER_FIELDS_TOO_LARGE is "431";
const string: HTTP_UNAVAILABLE_FOR_LEGAL_REASONS is "451";
const string: HTTP_INTERNAL_SERVER_ERROR is "500";
const string: HTTP_NOT_IMPLEMENTED is "501";
const string: HTTP_BAD_GATEWAY is "502";
const string: HTTP_SERVICE_UNAVAILABLE is "503";
const string: HTTP_GATEWAY_TIMEOUT is "504";
const string: HTTP_VERSION_NOT_SUPPORTED is "505";
const string: HTTP_VARIANT_ALSO_NEGOTIATES is "506";
const string: HTTP_INSUFFICIENT_STORAGE is "507";
const string: HTTP_LOOP_DETECTED is "508";
const string: HTTP_NOT_EXTENDED is "510";
const string: HTTP_NETWORK_AUTHENTICATION_REQUIRED is "511";
const type: httpLocation is new struct
var boolean: httpsProtocol is FALSE;
var string: serverName is "";
var integer: portNumber is 0;
var string: hostName is "";
var string: path is "";
var string: params is "";
var array string: cookies is 0 times "";
end struct;
const proc: show (in httpLocation: location) is func
begin
writeln("httpsProtocol: " <& location.httpsProtocol);
writeln("serverName: " <& location.serverName);
writeln("portNumber: " <& location.portNumber);
writeln("hostName: " <& location.hostName);
writeln("path: " <& location.path);
writeln("params: " <& location.params);
end func;
const type: httpBody is new struct
var string: contentType is "";
var string: content is "";
end struct;
const type: httpCreds is new struct
var string: username is "";
var string: password is "";
var boolean: utilize is TRUE;
end struct;
const func httpCreds: basicAuth (in string: username, in string: password) is func
result
var httpCreds: creds is httpCreds.value;
begin
creds.username := username;
creds.password := password;
creds.utilize := FALSE;
end func;
const func httpCreds: bearerAuth (in string: token) is func
result
var httpCreds: creds is httpCreds.value;
begin
creds.password := token;
end func;
const type: httpRequest is new struct
var string: method is "";
var httpLocation: location is httpLocation.value;
var httpBody: body is httpBody.value;
var httpCreds: creds is httpCreds.value;
end struct;
const func httpRequest: httpGetRequest (in httpLocation: locationData) is func
result
var httpRequest: request is httpRequest.value;
begin
request.location := locationData;
end func;
const type: httpResponse is new struct
var string: status is "";
var string: body is "";
end struct;
const proc: setProxy (in string: serverName, in integer: portNumber) is func
begin
proxyServer := serverName;
proxyHttpPort := portNumber;
end func;
const func httpLocation: getHttpLocation (in string: location, in integer: defaultPortNumber) is func
result
var httpLocation: locationData is httpLocation.value;
local
var integer: slashPos is 0;
var integer: questionMarkPos is 0;
var integer: rightBracketPos is 0;
var integer: colonPos is 0;
begin
slashPos := pos(location, "/");
questionMarkPos := pos(location, "?");
if slashPos = 0 then
if questionMarkPos = 0 then
locationData.hostName := location;
locationData.path := "";
locationData.params := "";
else
locationData.hostName := location[.. pred(questionMarkPos)];
locationData.path := "";
locationData.params := location[succ(questionMarkPos) ..];
end if;
else
if questionMarkPos = 0 then
locationData.hostName := location[.. pred(slashPos)];
locationData.path := location[succ(slashPos) ..];
locationData.params := "";
elsif slashPos < questionMarkPos then
locationData.hostName := location[.. pred(slashPos)];
locationData.path := location[succ(slashPos) .. pred(questionMarkPos)];
locationData.params := location[succ(questionMarkPos) ..];
else
locationData.hostName := location[.. pred(questionMarkPos)];
locationData.path := "";
locationData.params := location[succ(questionMarkPos) ..];
end if;
end if;
rightBracketPos := pos(locationData.hostName, "]:");
if rightBracketPos <> 0 and startsWith(locationData.hostName, "[") and
isDigitString(locationData.hostName[rightBracketPos + 2 ..]) and
length(locationData.hostName[rightBracketPos + 2 ..]) <= 18 then
locationData.portNumber := integer(locationData.hostName[rightBracketPos + 2 ..]);
locationData.hostName := locationData.hostName[2 .. pred(rightBracketPos)];
else
colonPos := pos(locationData.hostName, ":");
if colonPos <> 0 and
not isDigitString(locationData.hostName[.. pred(colonPos)]) and
isDigitString(locationData.hostName[succ(colonPos) ..]) and
length(locationData.hostName[succ(colonPos) ..]) <= 18 then
locationData.portNumber := integer(locationData.hostName[succ(colonPos) ..]);
locationData.hostName := locationData.hostName[.. pred(colonPos)];
else
locationData.portNumber := defaultPortNumber;
end if;
end if;
locationData.serverName := locationData.hostName;
end func;
const func string: toHttpAscii (in string: stri) is func
result
var string: encoded is "";
local
var string: stri8 is "";
var integer: pos is 0;
var integer: start is 1;
var char: ch is ' ';
begin
stri8 := toUtf8(stri);
for ch key pos range stri8 do
if ord(ch) >= 127 or ch < ' ' or
ch in {'%', '/', '?', '&', '=', '+'} then
encoded &:= stri8[start .. pred(pos)];
encoded &:= "%" <& ord(ch) RADIX 16 lpad0 2;
start := succ(pos);
elsif ch = ' ' then
encoded &:= stri8[start .. pred(pos)];
encoded &:= "+";
start := succ(pos);
end if;
end for;
encoded &:= stri8[start ..];
end func;
const proc: sendHttp (inout file: sock, in httpRequest: request) is func
local
var string: address is "";
var string: plain is "";
var integer: index is 0;
begin
address := "/" & request.location.path;
if request.location.params <> "" then
address &:= "?" & request.location.params;
end if;
if request.method <> "" then
plain &:= request.method <& " " <& address <& " HTTP/1.1\r\n";
elsif request.body.content = "" then
plain &:= "GET " <& address <& " HTTP/1.1\r\n";
else
plain &:= "POST " <& address <& " HTTP/1.1\r\n";
end if;
plain &:= "Host: " <& request.location.hostName <& "\r\n";
plain &:= "User-Agent: BlackHole" <& "\r\n";
if request.creds.username <> "" then
if pos(request.creds.username,':') = 0 then
plain &:= "Authorization: Basic " &
toBase64(request.creds.username & ":" & request.creds.password) & "\r\n";
else
raise RANGE_ERROR;
end if;
elsif request.creds.password <> "" then
plain &:= "Authorization: Bearer " & request.creds.password & "\r\n";
end if;
if length(request.location.cookies) <> 0 then
plain &:= "Cookie: ";
for key index range request.location.cookies do
plain &:= request.location.cookies[index];
if index < length(request.location.cookies) then
plain &:= "; ";
end if;
end for;
plain &:= "\r\n";
end if;
if request.body.contentType <> "" then
plain &:= "Content-Type: " & request.body.contentType & "\r\n";
plain &:= "Content-Length: " <& length(request.body.content) <& "\r\n";
plain &:= "\r\n" & request.body.content;
else
plain &:= "\r\n";
end if;
write(sock, plain);
end func;
const func file: openHttp (in httpLocation: locationData) is func
result
var file: sock is STD_NULL;
begin
if not locationData.httpsProtocol then
sock := openInetSocket(locationData.serverName, locationData.portNumber);
end if;
end func;
const func file: openHttp (in httpRequest: request) is func
result
var file: sock is STD_NULL;
begin
sock := openHttp(request.location);
if sock <> STD_NULL then
sendHttp(sock, request);
end if;
end func;
const func string: getHttpStatusCode (inout file: sock) is func
result
var string: statusCode is "";
local
var string: line is "";
var string: statusInfo is "";
var integer: spacePos is 0;
begin
line := getln(sock);
if startsWith(line, "HTTP") then
spacePos := pos(line, " ");
if spacePos <> 0 then
statusInfo := trim(line[spacePos ..]);
spacePos := pos(statusInfo, " ");
if spacePos = 0 then
statusCode := statusInfo;
else
statusCode := statusInfo[.. pred(spacePos)];
end if;
end if;
end if;
end func;
const type: httpHeader is new struct
var string: transferEncoding is "";
var string: contentType is "";
var string: charset is "";
var string: contentEncoding is "";
var integer: contentLength is 0;
var string: location is "";
var array string: cookies is 0 times "";
end struct;
const func httpHeader: getHttpHeader (inout file: sock) is func
result
var httpHeader: header is httpHeader.value;
local
var string: line is "";
var integer: colonPos is 0;
var string: fieldName is "";
var string: contentLengthStri is "";
var string: cookieName is "";
var string: cookieValue is "";
begin
line := getln(sock);
while line <> "" do
colonPos := pos(line, ':');
if colonPos <> 0 then
fieldName := lower(trim(line[.. pred(colonPos)]));
case fieldName of
when {"transfer-encoding"}:
header.transferEncoding := lower(trim(line[succ(colonPos) ..]));
when {"content-type"}:
header.contentType := trim(line[succ(colonPos) ..]);
header.charset := getValueOfHeaderAttribute(header.contentType, "charset");
when {"content-encoding"}:
header.contentEncoding := lower(trim(line[succ(colonPos) ..]));
when {"content-length"}:
contentLengthStri := trim(line[succ(colonPos) ..]);
if isDigitString(contentLengthStri) and
length(contentLengthStri) <= 18 then
header.contentLength := integer(contentLengthStri);
else
header.contentLength := -1;
end if;
when {"location"}:
header.location := trim(line[succ(colonPos) ..]);
when {"set-cookie"}:
line := line[succ(colonPos) ..];
cookieName := getHttpSymbol(line);
if getHttpSymbol(line) = "=" then
cookieValue := getHttpSymbol(line);
else
cookieValue := "";
end if;
header.cookies &:= cookieName & "=" & cookieValue;
end case;
end if;
line := getln(sock);
end while;
end func;
const func string: getHttpBody (inout file: sock, in httpHeader: header) is func
result
var string: data is "";
local
var string: line is "";
var integer: chunkSize is 0;
var integer: contentLength is 0;
var string: buffer is "";
begin
if header.transferEncoding = "chunked" then
if not eof(sock) then
line := getln(sock);
if isDigitString(line, 16) and
length(line) <= 15 then
chunkSize := integer(line, 16);
else
chunkSize := -1;
end if;
while chunkSize > 0 and not eof(sock) do
repeat
buffer := gets(sock, chunkSize);
chunkSize -:= length(buffer);
data &:= buffer;
until chunkSize = 0 or eof(sock);
if not eof(sock) then
ignore(getln(sock));
line := getln(sock);
if isDigitString(line, 16) and
length(line) <= 15 then
chunkSize := integer(line, 16);
else
chunkSize := -1;
end if;
end if;
end while;
end if;
elsif header.transferEncoding = "identity" or
header.transferEncoding = "" then
if header.contentLength > 0 then
contentLength := header.contentLength;
while contentLength <> 0 and not eof(sock) do
buffer := gets(sock, contentLength);
contentLength -:= length(buffer);
data &:= buffer;
end while;
else
buffer := gets(sock, 10000000);
while buffer <> "" do
data &:= buffer;
buffer := gets(sock, 10000000);
end while;
end if;
else
writeln("Unknown Transfer-Encoding: " <& literal(header.transferEncoding));
buffer := gets(sock, 10000000);
while buffer <> "" do
data &:= buffer;
buffer := gets(sock, 10000000);
end while;
end if;
if header.contentEncoding = "gzip" then
data := gunzip(data);
end if;
block
conv2unicodeByName(data, header.charset);
exception
catch RANGE_ERROR:
data := "";
end block;
end func;
const func string: getHttp (inout file: sock) is func
result
var string: data is "";
local
var httpHeader: header is httpHeader.value;
begin
header := getHttpHeader(sock);
data := getHttpBody(sock, header);
end func;
const func httpLocation: getHttpLocation (in httpLocation: currentLocationData,
inout file: sock) is func
result
var httpLocation: locationData is httpLocation.value;
local
var httpHeader: header is httpHeader.value;
var string: location is "";
begin
header := getHttpHeader(sock);
if header.location <> "" then
location := header.location;
if startsWith(location, "http:") then
location := trim(location[6 ..]);
while startsWith(location, "/") do
location := location[2 ..];
end while;
locationData := getHttpLocation(location, httpDefaultPort);
elsif startsWith(location, "https:") then
location := trim(location[7 ..]);
while startsWith(location, "/") do
location := location[2 ..];
end while;
locationData := getHttpLocation(location, httpsDefaultPort);
locationData.httpsProtocol := TRUE;
else
if not startsWith(location, "/") then
location := currentLocationData.path & "/" & location;
end if;
locationData := getHttpLocation(location, currentLocationData.portNumber);
locationData.httpsProtocol := currentLocationData.httpsProtocol;
locationData.serverName := currentLocationData.serverName;
locationData.hostName := currentLocationData.hostName;
end if;
end if;
locationData.cookies := header.cookies;
end func;
const func httpResponse: sendHttp (in var httpRequest: request, in boolean: proxy) is func
result
var httpResponse: response is httpResponse.value;
local
var file: sock is STD_NULL;
var string: location is "";
var boolean: okay is TRUE;
var integer: repeatCount is 0;
begin
if proxy and proxyServer <> "" then
request.location.serverName := proxyServer;
request.location.portNumber := proxyHttpPort;
end if;
repeat
okay := TRUE;
sock := openHttp(request);
if sock <> STD_NULL then
response.status := getHttpStatusCode(sock);
if response.status = HTTP_MOVED_PERMANENTLY or
response.status = HTTP_FOUND or
response.status = HTTP_SEE_OTHER or
response.status = HTTP_TEMPORARY_REDIRECT then
request.location := getHttpLocation(request.location, sock);
close(sock);
sock := STD_NULL;
okay := FALSE;
incr(repeatCount);
elsif response.status = HTTP_UNAUTHORIZED and
request.creds.username <> "" and
not request.creds.utilize then
request.creds.utilize := TRUE;
close(sock);
sock := STD_NULL;
okay := FALSE;
end if;
end if;
until okay or repeatCount > 5;
if sock <> STD_NULL then
response.body := getHttp(sock);
close(sock);
end if;
end func;
const func httpResponse: sendHttp (in var httpRequest: request) is
return sendHttp(request, FALSE);
const func httpResponse: http (GET, in string: location) is func
result
var httpResponse: response is httpResponse.value;
local
var httpRequest: request is httpRequest.value;
begin
request.location := getHttpLocation(location, httpDefaultPort);
response := sendHttp(request, TRUE);
end func;
const func httpResponse: http (GET, in string: location, in httpCreds: creds) is func
result
var httpResponse: response is httpResponse.value;
local
var httpRequest: request is httpRequest.value;
begin
request.location := getHttpLocation(location, httpDefaultPort);
request.creds := creds;
response := sendHttp(request, TRUE);
end func;
const func httpResponse: http (DELETE, in string: location, in httpCreds: creds) is func
result
var httpResponse: response is httpResponse.value;
local
var httpRequest: request is httpRequest.value;
begin
request.method := "DELETE";
request.location := getHttpLocation(location, httpDefaultPort);
request.creds := creds;
response := sendHttp(request, TRUE);
end func;
const func httpResponse: http (DELETE, in string: location) is
return http(DELETE, location, httpCreds.value);
const func httpResponse: http (POST, in string: location, in httpBody: body, in httpCreds: creds) is func
result
var httpResponse: response is httpResponse.value;
local
var httpRequest: request is httpRequest.value;
begin
request.method := "POST";
request.location := getHttpLocation(location, httpDefaultPort);
request.body := body;
request.creds := creds;
response := sendHttp(request, TRUE);
end func;
const func httpResponse: http (POST, in string: location, in httpBody: body) is
return http(POST, location, body, httpCreds.value);
const func httpResponse: http (POST, in string: location, in string: body, in httpCreds: creds) is func
result
var httpResponse: response is httpResponse.value;
local
var httpRequest: request is httpRequest.value;
begin
request.method := "POST";
request.location := getHttpLocation(location, httpDefaultPort);
request.body.content := body;
request.body.contentType := "text/plain";
request.creds := creds;
response := sendHttp(request, TRUE);
end func;
const func httpResponse: http (POST, in string: location, in string: body) is
return http(POST, location, body, httpCreds.value);
const func httpResponse: http (POST, in string: location, in hash [string] string: fields, in httpCreds: creds) is func
result
var httpResponse: response is httpResponse.value;
local
var httpRequest: request is httpRequest.value;
var string: name is "";
var string: value is "";
begin
request.method := "POST";
request.location := getHttpLocation(location, httpDefaultPort);
request.body.contentType := "application/x-www-form-urlencoded";
for value key name range fields do
request.body.content &:= toHttpAscii(name) & "=" & toHttpAscii(value) & "&";
end for;
if endsWith(request.body.content, "&") then
request.body.content := request.body.content[.. length(request.body.content)-1];
end if;
request.creds := creds;
response := sendHttp(request, TRUE);
end func;
const func httpResponse: http (POST, in string: location, in hash [string] string: fields) is
return http(POST, location, fields, httpCreds.value);