| Author: | Yegor Samusev <yegor@samusev.pp.ru> |
|---|---|
| Modified: | 2010-11-22 |
Here I put my own source code examples for various programming languages. All of them are placed in the public domain.
Contents
All examples can be compiled with XDS.
Have a look at my Modula-2 links ru.
Code:
MODULE SimpleCGIApplication;
FROM STextIO IMPORT WriteString;
FROM Strings IMPORT Concat;
IMPORT ProgEnv; (* XDS only *)
CONST
CR = CHR(0DH);
LF = CHR(0AH);
CRLF = ARRAY OF CHAR {CR, LF};
PROCEDURE WriteHeader(FieldName, FieldValue: ARRAY OF CHAR);
VAR
Buf: ARRAY [1..70] OF CHAR;
BEGIN
Concat(FieldName, ": ", Buf);
Concat(Buf, FieldValue, Buf);
Concat(Buf, CRLF, Buf);
WriteString(Buf);
END WriteHeader;
PROCEDURE WriteEnvString(Name: ARRAY OF CHAR);
VAR
Buf: ARRAY [1..70] OF CHAR;
EnvValue: ARRAY [1..30] OF CHAR;
BEGIN
IF ProgEnv.StringLength(Name) # 0 THEN
ProgEnv.String(Name, EnvValue);
Concat(Name, " = ", Buf);
Concat(Buf, EnvValue, Buf);
Concat(Buf, CRLF, Buf);
WriteString(Buf);
END;
END WriteEnvString;
BEGIN
WriteHeader("Content-Type", "text/plain");
WriteString(CRLF);
WriteEnvString("SERVER_SOFTWARE");
WriteEnvString("SERVER_NAME");
WriteEnvString("GATEWAY_INTERFACE");
WriteEnvString("SERVER_PROTOCOL");
WriteEnvString("SERVER_PORT");
WriteEnvString("REQUEST_METHOD");
WriteEnvString("HTTP_ACCEPT");
WriteEnvString("PATH_INFO");
WriteEnvString("PATH_TRANSLATED");
WriteEnvString("SCRIPT_NAME");
WriteEnvString("QUERY_STRING");
WriteEnvString("REMOTE_HOST");
WriteEnvString("REMOTE_ADDR");
WriteEnvString("REMOTE_USER");
WriteEnvString("AUTH_TYPE");
WriteEnvString("CONTENT_TYPE");
WriteEnvString("CONTENT_LENGTH");
END SimpleCGIApplication.
Don't forget to pass the +M2EXTENSIONS argument to the Modula-2 compiler.
Code:
MODULE FreeBSDSystemCall;
FROM Strings IMPORT Concat, Length;
FROM STextIO IMPORT WriteString, WriteLn;
FROM SWholeIO IMPORT WriteInt;
TYPE
size_t = CARDINAL;
CONST
LF = ARRAY OF CHAR {CHR(0AH)};
VAR
d: INTEGER;
buf: ARRAY[1..16] OF CHAR;
nbytes: CARDINAL;
Val: INTEGER;
PROCEDURE write(d: INTEGER; buf: ARRAY OF CHAR; nbytes: size_t): INTEGER;
CONST
SC_WRITE = 4;
VAR
Val: INTEGER;
BEGIN
ASM
mov eax,SC_WRITE
push nbytes
push DWORD PTR buf
push d
push eax
int 080H
add esp,16
mov [Val],eax
END;
RETURN Val;
END write;
BEGIN
d := 1;
Concat("Hello world!", LF, buf);
nbytes := Length(buf);
Val := write(d, buf, nbytes);
WriteString("Return value of write(): ");
WriteInt(Val, 1);
WriteLn;
END FreeBSDSystemCall.
rep (AKA librep) is a dialect of Lisp and Scheme.
Have a look at my rep links ru.
It supports only GET requests (and maybe some other).
Code:
(require 'rep.io.sockets)
(define (raw-http-client host
#!key (method 'get) (port 80) (path "/") (secs 10))
(let* ((method (string-upcase (symbol-name method)))
(stream (make-string-output-stream ""))
(socket (socket-client host port stream)))
(write socket (concat method " " path " HTTP/1.1\r\n"
"Host: " host ":" (number->string port) "\r\n"
"Connection: close\r\n\r\n"))
(accept-socket-output-1 socket secs)
(close-socket socket)
stream))
Test:
user> (raw-http-client "fidoman.ru" #:method 'head)
("HTTP/1.1 200 OK\015\012Date: Mon, 21 Jun 2010 20:13:26 GMT\015\012Server: Apac
he/2.2.9 (Debian)\015\012Last-Modified: Thu, 04 Sep 2008 10:08:50 GMT\015\012ETa
g: \"3dd68-1ba-4560f23aed080\"\015\012Accept-Ranges: bytes\015\012Content-Length
: 442\015\012Connection: close\015\012Content-Type: text/html; charset=utf-8\015
\012\015\012" . 269)
It's a dirty example implementing the Daytime Protocol (RFC 867). It's dirty because you can't normally close a socket. The server runs in a forever loop. :)
Code:
(require 'rep.io.sockets)
(define (daytime-server #!key host (port 13) format)
(let ((socket
(socket-server host
port
(lambda (socket)
(let ((client (socket-accept socket)))
(write client
(concat (current-time-string nil format)
"\r\n"))
(close-socket client))))))
(while t (accept-socket-output-1 socket 10))))
Run:
user> (daytime-server #:host "127.0.0.1" #:port 1313 #:format "%Y-%m-%d %H:%M:%S")
Test:
%nc 127.0.0.1 1313 2010-06-23 23:42:10
Please read my notes about Scheme and have a look at my links ru.
It supports GET and POST (it isn't well tested) requests. I'm sure you can write better.
Chicken:
(require-extension srfi-13)
(require-extension tcp)
(define (download input-port buffer-length content)
(let ((buffer (read-string buffer-length input-port)))
(if (string=? buffer "")
content
(download input-port
buffer-length
(string-concatenate (list content buffer))))))
(define (raw-http-client host #!key (port 80) (method 'get) (path "/")
(body "") (buffer-length 4096))
(let* ((method (string-upcase (symbol->string method)))
(base-headers (string-concatenate
(list method " " path " HTTP/1.1\r\n"
"Host: " host ":" (number->string port) "\r\n"
"Connection: close\r\n")))
(query (string-concatenate
(if (string= method "POST")
(list base-headers
(string-concatenate
(list "Content-Length: "
(number->string (string-length body))
"\r\n\r\n"))
body)
(list base-headers "\r\n")))))
(let-values (((input output) (tcp-connect host port)))
(write-string query (string-length query) output)
(download input buffer-length ""))))
Run:
> (raw-http-client "fidoman.ru" path: "/robots.txt" buffer-length: 83) "HTTP/1.1 404 Not Found\r\nDate: Tue, 29 Jun 2010 22:42:58 GMT\r\nServer: Apache /2.2.9 (Debian)\r\nContent-Length: 283\r\nConnection: close\r\nContent-Type: tex t/html; charset=iso-8859-1\r\n\r\n<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0/ /EN\">\n<html><head>\n<title>404 Not Found</title>\n</head><body>\n<h1>Not Found </h1>\n<p>The requested URL /robots.txt was not found on this server.</p>\n<hr>\ n<address>Apache/2.2.9 (Debian) Server at fidoman.ru Port 80</address>\n</body>< /html>\n"
Here are simple examples that show how to start threads. First of all we define a do-something function:
(define (display-numbers from till)
(do ((n from ((if (> from till) - +) n 1)))
((= n till))
(display n)
(display " ")))
I'm sure you guess that it just displays numbers. :) Ok. Then we start two threads and every thread will execute this function but with different arguments. Because we have various Scheme implementations, we also have different ways to start threads but note that there is the “SRFI 18: Multithreading support” document and some Schemes follow this way.
Chicken (SRFI 18):
(require-extension srfi-18)
(let ((thread-1 (make-thread (lambda () (display-numbers 1000 2000))))
(thread-2 (make-thread (lambda () (display-numbers 2000 3000)))))
(begin (thread-start! thread-1)
(thread-start! thread-2)
(thread-join! thread-1)
(thread-join! thread-2)))
Guile:
; Example #1
(let ((thread-1 (make-thread (lambda () (display-numbers 1000 2000))))
(thread-2 (make-thread (lambda () (display-numbers 2000 3000)))))
(begin (begin-thread thread-1 thread-2)
(join-thread thread-1)
(join-thread thread-2)))
; Example #2
(begin (call-with-new-thread (lambda () (display-numbers 1000 2000)))
(call-with-new-thread (lambda () (display-numbers 2000 3000))))
Scheme 48:
Don't forget to do in REPL:
> ,open threads
Run:
(begin (spawn (lambda () (display-numbers 1000 2000)))
(spawn (lambda () (display-numbers 2000 3000))))
N.B.: Scheme 48 is not a scripting language.