Skip to content

Instantly share code, notes, and snippets.

@hodzanassredin

hodzanassredin/clockhouse.mod

Created May 7, 2023 10:58
Show Gist options
  • Save hodzanassredin/70a93b604d7cfc28a9bf05d171148cc6 to your computer and use it in GitHub Desktop.
Save hodzanassredin/70a93b604d7cfc28a9bf05d171148cc6 to your computer and use it in GitHub Desktop.
Download ZIP
blackbox clickhouse http
Raw
clockhouse.mod
MODULE HttpCmds;
(* This module provides the commands required to start and configure a singleton http or https server
and shows how to provide a REST API for Component Pascal modules.
It also includes an http test client.
For the REST API it implements a servlet (MyServlet) that can be registered with an http or https server e.g. under
the URI prefix /. With 'http://localhost/calc?x=1&y=2' a procedure Calc is called and its result returned in XML format.
The special request 'testPOST' opens a form that allows to call Calc by means of a POST method.
2016-07-26, Josef Templ, first version
*)
IMPORT HttpServers, HttpWeb, Strings, Files, CommStreams, TextModels, TextViews, Views, Log, StringsUtf, DS:=StringsDyn, CSR:=CommStreamsReader, Conv:=YSonConverters, M:=YSonModels;
CONST
xmlHdr = '<?xml version="1.0" encoding="UTF-8"?>' ;
testPOST_Form = '<html><head><title>testPOST</title></head><body>'
+ '<form action="/calc" method="post">'
+ ' <input type="text" name="x" value="x" />'
+ ' <input type="text" name="y" value="y" />'
+ ' <input type="submit" />'
+ '</form>'
+ '</body></html>';
TYPE
MyServlet = POINTER TO RECORD (HttpServers.Servlet) END;
Data* = RECORD
clusterName* : ARRAY 32 OF CHAR;
END;
VAR
server: HttpServers.Server;
uiData* : Data;
PROCEDURE GetParam(req: HttpServers.Request; res: HttpServers.Response;
IN key: ARRAY OF CHAR): HttpServers.String;
VAR val: HttpServers.String;
BEGIN
IF res.Error() THEN RETURN NIL END; (* don't overwrite error message *)
val := req.GetParam(key);
IF val = NIL THEN
res.SetErrorResponse(HttpServers.STATUS_BadRequest, "Bad Request",
"missing parameter: " + key)
END;
RETURN val
END GetParam;
PROCEDURE GetIntParam(req: HttpServers.Request; res: HttpServers.Response;
IN key: ARRAY OF CHAR): INTEGER;
VAR val: HttpServers.String; x, r: INTEGER;
BEGIN val := GetParam(req, res, key);
IF res.Error() THEN RETURN 0 END; (* don't overwrite error message *)
Strings.StringToInt(val, x, r);
IF r # 0 THEN
res.SetErrorResponse(HttpServers.STATUS_BadRequest, "Bad Request",
"integer number expected: " + key + "=" + val$)
END;
RETURN x
END GetIntParam;
PROCEDURE Calc(x, y: INTEGER; VAR sum, min, max: INTEGER);
BEGIN
sum := x + y;
IF x <= y THEN min:= x ELSE min := y END;
IF x >= y THEN max:= x ELSE max := y END;
END Calc;
PROCEDURE HandleCalc(req: HttpServers.Request; res: HttpServers.Response);
VAR x, y, sum, min, max: INTEGER;
sumStr, minStr, maxStr: ARRAY 20 OF CHAR;
BEGIN
(* get parameters *)
x := GetIntParam(req, res, "x");
y := GetIntParam(req, res, "y");
IF ~res.Error() THEN
(* perform computation *)
Calc(x, y, sum, min, max);
(* set response *)
Strings.IntToString(sum, sumStr);
Strings.IntToString(min, minStr);
Strings.IntToString(max, maxStr);
res.SetContentText(
HttpServers.NewSString(xmlHdr + "<response>"
+ "<sum>" + SHORT(sumStr) + "</sum>"
+ "<min>" + SHORT(minStr) + "</min>"
+ "<max>" + SHORT(maxStr) + "</max>"
+ "</response>"),
"text/xml; charset=utf-8");
(* IF req.GetField("cookie") = NIL THEN res.SetField("Set-Cookie", "session=testsession") END; *)
res.SetStatusOK
END
END HandleCalc;
PROCEDURE (this: MyServlet) HandleRequest* (req: HttpServers.Request; res: HttpServers.Response);
BEGIN
IF req.path$ = "calc" THEN
HandleCalc(req, res)
ELSIF req.path$ = "testPOST" THEN (* set up a form for testing POST *)
res.SetContentText(HttpServers.NewSString(testPOST_Form), "text/html; charset=utf-8");
res.SetStatusOK
ELSE
res.SetErrorResponse(HttpServers.STATUS_NotFound, "Not Found", "unknown API function: " + req.path)
END
END HandleRequest;
PROCEDURE NewServer*;
BEGIN
IF server # NIL THEN server.Stop END;
server := HttpServers.NewServer();
END NewServer;
PROCEDURE RegEchoServlet* (uriPrefix: ARRAY OF CHAR);
VAR echoServlet: HttpServers.EchoServlet;
BEGIN
NEW(echoServlet);
server.RegisterServlet(echoServlet, uriPrefix, {0..8});
END RegEchoServlet;
PROCEDURE RegWebServlet* (uriPrefix, wwwRoot, indexPage: ARRAY OF CHAR; enumDirs: BOOLEAN);
VAR webServlet: HttpWeb.Servlet;
BEGIN
webServlet := HttpWeb.NewServlet(Files.dir.This(wwwRoot), indexPage$, enumDirs);
server.RegisterServlet(webServlet, uriPrefix, {0, 2});
END RegWebServlet;
PROCEDURE RegMyServlet* (uriPrefix: ARRAY OF CHAR);
VAR myServlet: MyServlet;
BEGIN
NEW(myServlet);
server.RegisterServlet(myServlet, uriPrefix, {0, 2});
END RegMyServlet;
PROCEDURE RegFaviconServlet* (dir, name: ARRAY OF CHAR);
VAR favicon: HttpWeb.FaviconServlet;
BEGIN
favicon := HttpWeb.NewFaviconServlet(dir$, name$);
server.RegisterServlet(favicon, "/favicon.ico", {0..2});
END RegFaviconServlet;
PROCEDURE Start* (protocol, localAdr: ARRAY OF CHAR);
BEGIN
server.Start(protocol, localAdr);
END Start;
PROCEDURE Stop*;
BEGIN
IF server # NIL THEN server.Stop() END
END Stop;
PROCEDURE Suspend*;
BEGIN
IF server # NIL THEN server.Suspend() END
END Suspend;
PROCEDURE Resume*;
BEGIN
IF server # NIL THEN server.Resume() END
END Resume;
PROCEDURE SetTiming*(period, ticks, waitCycles: INTEGER);
BEGIN
IF server # NIL THEN server.SetTiming(period, ticks, waitCycles) END
END SetTiming;
PROCEDURE SetAccessLog*(IN dir, name: ARRAY OF CHAR);
BEGIN
IF server # NIL THEN server.SetAccessLog(dir$, name$) END
END SetAccessLog;
PROCEDURE LogVerbose*;
BEGIN HttpServers.log_VERBOSE := ~HttpServers.log_VERBOSE
END LogVerbose;
PROCEDURE LogRequest*; (* for debugging *)
BEGIN HttpServers.log_URI := ~HttpServers.log_URI
END LogRequest;
PROCEDURE LogCon*; (* for debugging *)
BEGIN HttpServers.log_CON := ~HttpServers.log_CON
END LogCon;
PROCEDURE SetRows(v: M.Value);
VAR
data, row, cluster: M.Value;
arr : M.Array;
len, i : INTEGER;
str : POINTER TO ARRAY OF CHAR;
BEGIN
WITH v: M.Object DO
data := v.Find("data");
ELSE HALT(100) END;
WITH data: M.Array DO
len := data.GetLength() - 1;
FOR i := 0 TO len DO
row := data.Get(i);
WITH row: M.Object DO
cluster := row.Find("cluster");
WITH cluster: M.String DO
str:= cluster.Get();
FOR i:=0 TO LEN(str)-1 DO
uiData.clusterName[i] := str[i]
END
ELSE HALT(100) END;
ELSE HALT(100) END;
END
ELSE HALT(100) END;
END SetRows;
PROCEDURE TestHttpClient* (localAdr, remoteAdr, uri, method: ARRAY OF CHAR; body: HttpServers.SString; headers : HttpServers.HeaderField);
CONST CRLF = "" + 0DX + 0AX;EMPTY_LINE = CRLF + CRLF;
VAR stream: CommStreams.Stream;
res, beg, len, i, written, read: INTEGER;
request: ARRAY 256 OF CHAR;
buf: ARRAY 2000 OF BYTE;
c : BYTE;
r: CSR.Reader;
t: TextModels.Model; w: TextModels.Writer;
fld: HttpServers.HeaderField;
v: M.Value;
char : CHAR;
lstr : DS.DynString;
BEGIN
Log.String("localAdr " + localAdr);Log.Ln;
Log.String("remoteAdr " + remoteAdr);Log.Ln;
Log.String("localAdr " + localAdr);Log.Ln;
CommStreams.NewStream("CommTCP", localAdr, remoteAdr, stream, res);
ASSERT(stream # NIL);
ASSERT(stream.IsConnected());
request := method + " " + uri + " HTTP/1.0" + CRLF + "Host: " + remoteAdr + CRLF;
fld := headers;
WHILE fld # NIL DO
request := request + fld.key + ": " + fld.val + CRLF;
fld := fld.next;
END;
request := request + CRLF;
Log.String(request);Log.Ln;
beg := 0; len := LEN(request$);
FOR i := 0 TO len - 1 DO buf[i] := SHORT(SHORT(ORD(request[i]))) END;
IF body # NIL THEN
FOR i := 0 TO LEN(body) - 1 DO buf[i + len] := SHORT(ORD(body[i])) END;
len := len + LEN(body);
END;
WHILE stream.IsConnected() & (len > 0) DO
stream.WriteBytes(buf, beg, len, written);
INC(beg, written); DEC(len, written);
END;
ASSERT(stream.IsConnected());
t := TextModels.dir.New();
w := t.NewWriter(NIL);
CSR.NewReader(stream, r);
IF r.SearchString(EMPTY_LINE) THEN
Log.String("found body");Log.Ln;
lstr := DS.Create("") ;
WHILE ~r.eof DO
char:= r.ReadUtf8Char(res);
IF res > -1 THEN
w.WriteChar(char) ;
lstr.AddChar(char)
END;
END;
Views.OpenAux(TextViews.dir.New(t), "Response");
v:=Conv.Load(lstr, res);
SetRows(v);
Conv.Store(v, NIL, res);
ELSE
Log.String("Not found body");Log.Ln;
END;
stream.Close;
END TestHttpClient;
PROCEDURE TestHttpClientGet* (localAdr, remoteAdr, uri: ARRAY OF CHAR);
BEGIN
TestHttpClient(localAdr, remoteAdr, uri, "GET", NIL, NIL)
END TestHttpClientGet;
PROCEDURE GetHeader (IN key, value: ARRAY OF SHORTCHAR):HttpServers.HeaderField;
VAR fld: HttpServers.HeaderField;
BEGIN NEW(fld); fld.key := key$; fld.val := HttpServers.NewSString(value);
RETURN fld;
END GetHeader;
PROCEDURE AddHeader (curr, next: HttpServers.HeaderField);
VAR fld: HttpServers.HeaderField;
BEGIN
ASSERT(curr # NIL);
fld := curr;
WHILE fld.next # NIL DO
fld := fld.next;
END;
ASSERT(fld.next = NIL);
fld.next := next
END AddHeader;
PROCEDURE TestHttpClientPost* (localAdr, remoteAdr, uri, body: ARRAY OF CHAR; custom_headers : HttpServers.HeaderField);
VAR
body_len_str : ARRAY 7 OF CHAR;
body_arr : HttpServers.SString;
len:INTEGER;
headers : HttpServers.HeaderField;
BEGIN
len:=StringsUtf.Utf8Size(body);
NEW(body_arr, len);
StringsUtf.ToUtf8(body,body_arr);
Strings.IntToString(len - 1, body_len_str);
headers := GetHeader("Content-Length", SHORT(body_len_str$));
AddHeader(headers, custom_headers);
TestHttpClient(localAdr, remoteAdr, uri, "POST", body_arr, headers);
END TestHttpClientPost;
PROCEDURE TestPost* ();
BEGIN
TestHttpClientPost('0.0.0.0', 'localhost:8080', '/', 'body', GetHeader("Content-Type", 'text/html;charset=utf-8'))
END TestPost;
PROCEDURE QueryClickhouse* (query, user, password:ARRAY OF CHAR);
VAR custom_headers : HttpServers.HeaderField;
BEGIN
custom_headers := GetHeader("Content-Type", 'text/plain;charset=UTF-8');
AddHeader(custom_headers, GetHeader("user",SHORT(user) ));
AddHeader(custom_headers, GetHeader("password",SHORT(password)));
TestHttpClientPost('0.0.0.0', 'localhost:8123', '/?user='+user+'&password=' + password, query, custom_headers)
END QueryClickhouse;
CLOSE
IF server # NIL THEN server.Stop END;
END HttpCmds.
"HttpCmds.TestHttpClientGet('0.0.0.0', 'rc1a-0zluga106lpalg9m.mdb.yandexcloud.net:8123', '/?user=writer&password=BmtdjvbxelDUgZYq5msdnAkV&query=select cluster from system.clusters')"
"HttpCmds.TestPost()"
"HttpCmds.TestHttpClientGet('0.0.0.0', 'localhost:29002', '/')"
"HttpCmds.QueryClickhouse('select cluster from system.clusters FORMAT JSONStrings', 'user', 'password')"
"YSonStreamConverter.Install()"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment