~retropikzel/fcgi-bridge

d258dac0f7cc0f1cf4f79fb981cf6a22f7c49e1e — retropikzel 6 months ago 81e4a98
Stuff goes trough to the SCGI server
M Makefile => Makefile +10 -2
@@ 1,9 1,9 @@
dist:
	mkdir -p dist

dist/fcgi2scgi.fcgi: libs dist src/fcgi2scgi.c
dist/fcgi2scgi: libs dist src/fcgi2scgi.c
	zig cc --target=x86_64-linux-musl \
		-o dist/fcgi2scgi.fcgi \
		-o dist/fcgi2scgi \
		src/fcgi2scgi.c \
		./libs/fcgi2-2.4.2/libfcgi/os_unix.c \
		./libs/fcgi2-2.4.2/libfcgi/fcgiapp.c \


@@ 29,3 29,11 @@ clean-all:
	rm -rf libs
	rm -rf dist/*

deploy:
	rm -rf sftp/public_html/test/fcgi2scgi
	cp dist/fcgi2scgi sftp/public_html/test/fcgi2scgi
	cp bridge.cgi sftp/public_html/test/bridge.cgi
	cp test/scgiclient/src/main.scm sftp/public_html/test/main.scm
	cp -r test/scgiclient/schubert sftp/public_html/test/



A bridge.cgi => bridge.cgi +17 -0
@@ 0,0 1,17 @@
#!/bin/bash
# vim: ft=bash

PORT=$((3000 + $RANDOM % 1000))

#printf "Content-Type: text/html"
#printf "\r\n"
#printf "\r\n"

#printf "Hello"

/usr/www/users/retrops/programs/bin/gosh -I ./schubert main.scm $PORT > scgi_output.txt 2>&1 &
sleep 2
exec ./fcgi2scgi $PORT > fcgi2scgi_output.txt 2>&1




A dist/fcgi2scgi => dist/fcgi2scgi +0 -0
M dist/fcgi2scgi.fcgi => dist/fcgi2scgi.fcgi +0 -0
M init.sh => init.sh +3 -1
@@ 1,2 1,4 @@
#!/bin/bash
echo "Hell from init" > init_output.txt


pwd > init_output.txt

M manifest.scm => manifest.scm +1 -1
@@ 2,4 2,4 @@
;; You can store it in a file that you may then pass to any 'guix' command
;; that accepts a '--manifest' (or '-m') option.

(specifications->manifest (list "zig" "gcc-toolchain" "autogen" "m4" "make" "autoconf" "automake" "libtool"))
(specifications->manifest (list "zig" "gcc-toolchain" "autogen" "m4" "make" "autoconf" "automake" "libtool" "gauche"))

M src/fcgi2scgi.c => src/fcgi2scgi.c +81 -3
@@ 1,16 1,94 @@
#include <stdlib.h>
#include <string.h>
#include<sys/socket.h>
#include<arpa/inet.h>
#include <unistd.h>
#include "fcgi_config.h"
#include "fcgi_stdio.h"

extern char **environ;

int main () {
static void PrintEnv(char *label, char **envp)
{
    printf("%s:<br>\n<pre>\n", label);
    for ( ; *envp != NULL; envp++) {
        printf("%s\n", *envp);
    }
    printf("</pre><p>\n");
}

static void build_scgi_message(char* message, char **envpointer) {
    for ( ; *envpointer != NULL; envpointer++) {
        printf("%s\n", *envpointer);
    }
}

int main(int argc, char *argv[]) {
    char **initialEnv = environ;

    int socket_desc = socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
    struct sockaddr_in server;
    server.sin_addr.s_addr = inet_addr("127.0.0.1");
    server.sin_family = AF_INET;
    server.sin_port = htons((int)strtol(argv[1], (char **)NULL, 10));
    int connection_status = connect(socket_desc , (struct sockaddr *)&server , sizeof(server));
    int count = 0;
    char* old_message = "72:CONTENT_LENGTH\0" "0\0SCGI\0" "1\0REQUEST_METHOD\0GET\0REQUEST_URI\0/hello\0,0:,";
    char server_reply[4000];
    char* scgi_message = malloc(0);
    while (FCGI_Accept() >= 0) {
        printf("Content-type: text/html\r\n"
                "\r\n"
                "<title>FastCGI echo</title>"
                "<h1>FastCGI echo</h1>\n"
                "Request number %d\n", result);
        exit(0);
                "Request number %d\n, port: %s</br>", count, argv[1]);

        build_scgi_message(scgi_message, environ);
        char *contentLength = getenv("CONTENT_LENGTH");
        int len;
        if (contentLength != NULL) {
            len = strtol(contentLength, NULL, 10);
        }
        else {
            len = 0;
        }


        if (len <= 0) {
            printf("No data from standard input.<p>\n");
        }
        else {
            int i, ch;

            printf("Standard input:<br>\n<pre>\n");
            for (i = 0; i < len; i++) {
                if ((ch = getchar()) < 0) {
                    printf("Error: Not enough bytes received on standard input<p>\n");
                    break;
                }
                putchar(ch);
            }
            printf("\n</pre><p>\n");
        }
        PrintEnv("Request environment", environ);
        PrintEnv("Initial environment", initialEnv);

        if(connection_status < 0) {
            printf("Could not connect to SCGI server, status: %i</br>", connection_status);
            return 1;
        }
        printf("Connected to SCGI server</br>");
        if(send(socket_desc, old_message, 68, 0) < 0) {
            printf("Send to SCGI server failed</br>");
            return 1;
        }
        printf("Data Send to SCGI Server</br>");
        if(recv(socket_desc, server_reply, 4000, 0) < 0) {
            printf("Could not get answer from SCGI server</br>");
            return 1;
        }
        printf("Reply from SCGI server received</br>");
        printf("Server reply: %s", server_reply);
        return 0;
    }
}

A test/scgiclient/composition.scm => test/scgiclient/composition.scm +8 -0
@@ 0,0 1,8 @@
((packager . "retropikzel")
 (name . "scgiclient")
 (version . "v0-1-0")
 (type . "application")
 (license . "LGPL")
 (description . "For testing fastcgi-bridge")
 (dependencies
   (retropikzel scgi v0-3-0)))

A test/scgiclient/schubert/retropikzel/scgi/v0-3-0/composition.scm => test/scgiclient/schubert/retropikzel/scgi/v0-3-0/composition.scm +7 -0
@@ 0,0 1,7 @@
((packager . "retropikzel")
 (name . "scgi")
 (version . "v0-3-0")
 (type . "library")
 (license . "LGPL")
 (description . "")
 (dependencies ))

A test/scgiclient/schubert/retropikzel/scgi/v0-3-0/main.scm => test/scgiclient/schubert/retropikzel/scgi/v0-3-0/main.scm +256 -0
@@ 0,0 1,256 @@
;; Copyright 2022- by Joona "Retropikzel" Isoaho <retropikzel@iki.fi>
;; This program is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Lesser General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
;; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;; See the GNU Lesser General Public License for more details.
;;You should have received a copy of the GNU General Public License along with this program. If not, see <https://www.gnu.org/licenses/>.

(define-library
  (retropikzel scgi v0-3-0 main)
  (import (scheme base)
          (scheme write)
          (scheme char)
          (scheme process-context)
          (srfi 106))
  (export scgi-start
          scgi-add-request-middleware
          scgi-add-response-middleware)
  (begin

    (define request-middleware (list))
    (define response-middleware (list))
    (define encode-replacements
      (list (list " " "%20")
            (list " " "+")
            (list "!" "%21")
            (list "#" "%23")
            (list "$" "%24")
            (list "%" "%25")
            (list "&" "%26")
            (list "'" "%27")
            (list "(" "%28")
            (list ")" "%29")
            (list "*" "%2A")
            (list "+" "%2B")
            (list "," "%2C")
            (list "/" "%2F")
            (list ":" "%3A")
            (list ";" "%3B")
            (list "=" "%3D")
            (list "?" "%3F")
            (list "@" "%40")
            (list "[" "%5B")
            (list "]" "%5D")
            (list "<" "%3C")
            (list ">" "%3E")
            (list "\\" "%5C")
            (list "\"" "%22")
            (list "\n" "%0A")
            (list "\r" "%0D")))

    (define decode-replacements (map reverse encode-replacements))

    (define get-replacement
      (lambda (key mode)
        (let ((r (if (string=? mode "encode")
                   (assoc key encode-replacements)
                   (assoc key decode-replacements))))
          (if r (car (cdr r)) key))))

    (define endecode
      (lambda (mode s)
        (if (not s)
          ""
          (letrec ((s-length (string-length s))
                   (looper
                     (lambda (i result)
                       (if (< i s-length)
                         (let ((key-length (if (and (string=? mode "decode")
                                                    (string=? (string-copy s i (+ i 1)) "%")
                                                    (> s-length (+ i 2)))
                                             3
                                             1)))
                           (looper (+ i key-length)
                                   (string-append result
                                                  (get-replacement
                                                    (string-copy s i (+ i key-length))
                                                    mode))))
                         result))))
            (looper 0 "")))))

    (define url-encode
      (lambda (str)
        (cond ((string? str) (endecode "encode" str))
              (else str))))

    (define url-decode
      (lambda (str)
        (cond ((string? str) (endecode "decode" str))
              (else str))))

    (define scgi-split-by-zero->list
      (lambda (source)
        (let ((result (list))
              (source-size (bytevector-length source)))
          (letrec ((looper
                     (lambda (index last-index key value)
                       (if (< index source-size)
                         (if (and key value)
                           (begin
                             (if (> (bytevector-length key) 0)
                               (set! result
                                 (append
                                   result
                                   (list (cons (string->symbol (utf8->string key))
                                               (if (= (bytevector-length value) 0)
                                                 ""
                                                 (utf8->string value)))))))
                             (looper index last-index #f #f))
                           (if (= (bytevector-u8-ref source index) 0)
                             (let ((slice (bytevector-copy source last-index index)))
                               (if (not key)
                                 (looper (+ index 1) (+ index 1) slice value)
                                 (looper (+ index 1) (+ index 1) key slice)))
                             (looper (+ index 1) last-index key value)))))))
            (looper 0 0 #f #f))
          result)))

    (define scgi-query-string->list
      (lambda (query-string)
        (let* ((query-bytevector (string->utf8 (string-append query-string "==")))
               (query-bytevector-size (bytevector-length query-bytevector))
               (u8-equal (bytevector-u8-ref (string->utf8 "=") 0))
               (u8-and (bytevector-u8-ref (string->utf8 "&") 0)))
          (letrec ((looper (lambda (index)
                             (if (< index query-bytevector-size)
                               (begin
                                 (if (or (= (bytevector-u8-ref query-bytevector index) u8-equal)
                                         (= (bytevector-u8-ref query-bytevector index) u8-and))
                                   (bytevector-u8-set! query-bytevector index 0))
                                 (looper (+ index 1)))))))
            (looper 0))
          (scgi-split-by-zero->list query-bytevector))))

    (define scgi-netstring->list
      (lambda (netstring)
        (let ((request (list)))
          (letrec ((get-request
                     (lambda (index)
                       (if (= (bytevector-u8-ref netstring index) 58)
                         (bytevector-copy netstring (+ index 1))
                         (get-request (+ index 1))))))
            (if (> (bytevector-length netstring) 0)
              (scgi-split-by-zero->list (get-request 0))
              (list))))))


    (define scgi-get-request-body
      (lambda (request-bytes content-length)
        (letrec ((looper
                   (lambda (index)
                     (if (and (> (bytevector-length request-bytes) 0)
                              (= (bytevector-u8-ref request-bytes index) 0)
                              (= (bytevector-u8-ref request-bytes (+ index 1)) 44))
                       (utf8->string (bytevector-copy request-bytes (+ index 2)))
                       (looper (- index 1))))))
          (looper (- (bytevector-length request-bytes) 1)))))

    (define read-all-from-socket
      (lambda (socket result)
        (let ((bytes (socket-recv socket 4000)))
          (if (< (bytevector-length bytes) 4000)
            (bytevector-append result bytes)
            (read-all-from-socket socket (bytevector-append result bytes))))))

    (define scgi-handle
      (lambda (client-socket handler)
        (let* ((request-bytes (read-all-from-socket client-socket (bytevector))))
        (write request-bytes)
        (newline)
        (write (utf8->string request-bytes))
        (newline)
          (let*(
               (request (scgi-netstring->list request-bytes))
               (request-method (if (not (null? request)) (cdr (assoc 'REQUEST_METHOD request)) ""))
               (request-uri (if (not (null? request)) (cdr (assoc 'REQUEST_URI request)) ""))
               (content-length (if (not (null? request)) (string->number (cdr (assoc 'CONTENT_LENGTH request))) 0))
               (body (url-decode (if (> content-length 0) (scgi-get-request-body request-bytes content-length) "")))
               )
            (write request)
            (newline)
            (write content-length)
            (newline)
          (set! request (append request (list (cons 'BODY body))))
                  (for-each
                    (lambda (middleware-procedure)
                      (set! request (middleware-procedure request)))
                    request-middleware)
                  (let ((response (handler request)))
                    (for-each
                      (lambda (middleware-procedure)
                        (set! response (middleware-procedure response)))
                      response-middleware)
                    (display "Response: ")
                    (write response)
                    (newline)
                    (socket-send client-socket
                                 (string->utf8 (if (string? response)
                                                 response
                                                 ""))))
          #;(call-with-current-continuation
            (lambda (k)
              (with-exception-handler
                (lambda (ex)
                  (display "ERROR: " (current-error-port))
                  (newline (current-error-port))
                  (display request-uri (current-error-port))
                  (newline (current-error-port))
                  (display (error-object-message ex) (current-error-port))
                  (newline (current-error-port))
                  (display (error-object-irritants ex) (current-error-port))
                  (newline (current-error-port))
                  (write ex (current-error-port))
                  (newline (current-error-port))
                  (k 'exception))
                (lambda ()
                  (for-each
                    (lambda (middleware-procedure)
                      (set! request (middleware-procedure request)))
                    request-middleware)
                  (let ((response (handler request)))
                    (for-each
                      (lambda (middleware-procedure)
                        (set! response (middleware-procedure response)))
                      response-middleware)
                    (write response)
                    (newline)
                    (socket-send client-socket
                                 (string->utf8 (if (string? response)
                                                 response
                                                 ""))))))))))
        (socket-close client-socket)))

    (define scgi-listen
      (lambda (socket handler)
        (scgi-handle (socket-accept socket) handler)
        (scgi-listen socket handler)))

    (define scgi-start
      (lambda (port handler)
        (let ((socket (make-server-socket port)))
          (scgi-listen socket handler))))

    (define scgi-add-request-middleware
      (lambda (middleware-procedure)
        (set! request-middleware (append request-middleware (list middleware-procedure)))))

    (define scgi-add-response-middleware
      (lambda (middleware-procedure)
        (set! response-middleware (append response-middleware (list middleware-procedure)))))

    (define scgi-add-response-and-request-middleware
      (lambda (middleware-procedure)
        (set! request-middleware (append request-middleware (list middleware-procedure)))
        (set! response-middleware (append response-middleware (list middleware-procedure)))))))

A test/scgiclient/schubert/retropikzel/scgi/v0-3-0/scgi.scm => test/scgiclient/schubert/retropikzel/scgi/v0-3-0/scgi.scm +227 -0
@@ 0,0 1,227 @@
;; Copyright 2022- by Joona "Retropikzel" Isoaho <retropikzel@iki.fi>
;; This program is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Lesser General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
;; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;; See the GNU Lesser General Public License for more details.
;;You should have received a copy of the GNU General Public License along with this program. If not, see <https://www.gnu.org/licenses/>.

(define-library
  (retropikzel scgi v0-3-0 scgi)
  (import (scheme base)
          (scheme write)
          (scheme char)
          (srfi 106))
  (export scgi-start
          scgi-add-request-middleware
          scgi-add-response-middleware)
  (begin

    (define request-middleware (list))
    (define response-middleware (list))
    (define encode-replacements
      (list (list " " "%20")
            (list " " "+")
            (list "!" "%21")
            (list "#" "%23")
            (list "$" "%24")
            (list "%" "%25")
            (list "&" "%26")
            (list "'" "%27")
            (list "(" "%28")
            (list ")" "%29")
            (list "*" "%2A")
            (list "+" "%2B")
            (list "," "%2C")
            (list "/" "%2F")
            (list ":" "%3A")
            (list ";" "%3B")
            (list "=" "%3D")
            (list "?" "%3F")
            (list "@" "%40")
            (list "[" "%5B")
            (list "]" "%5D")
            (list "<" "%3C")
            (list ">" "%3E")
            (list "\\" "%5C")
            (list "\"" "%22")
            (list "\n" "%0A")
            (list "\r" "%0D")))

    (define decode-replacements (map reverse encode-replacements))

    (define get-replacement
      (lambda (key mode)
        (let ((r (if (string=? mode "encode")
                   (assoc key encode-replacements)
                   (assoc key decode-replacements))))
          (if r (car (cdr r)) key))))

    (define endecode
      (lambda (mode s)
        (if (not s)
          ""
          (letrec ((s-length (string-length s))
                   (looper
                     (lambda (i result)
                       (if (< i s-length)
                         (let ((key-length (if (and (string=? mode "decode")
                                                    (string=? (string-copy s i (+ i 1)) "%")
                                                    (> s-length (+ i 2)))
                                             3
                                             1)))
                           (looper (+ i key-length)
                                   (string-append result
                                                  (get-replacement
                                                    (string-copy s i (+ i key-length))
                                                    mode))))
                         result))))
            (looper 0 "")))))

    (define url-encode
      (lambda (str)
        (cond ((string? str) (endecode "encode" str))
              (else str))))

    (define url-decode
      (lambda (str)
        (cond ((string? str) (endecode "decode" str))
              (else str))))

    (define scgi-split-by-zero->list
      (lambda (source)
        (let ((result (list))
              (source-size (bytevector-length source)))
          (letrec ((looper
                     (lambda (index last-index key value)
                       (if (< index source-size)
                         (if (and key value)
                           (begin
                             (if (> (bytevector-length key) 0)
                               (set! result
                                 (append
                                   result
                                   (list (cons (string->symbol (utf8->string key))
                                               (if (= (bytevector-length value) 0)
                                                 ""
                                                 (utf8->string value)))))))
                             (looper index last-index #f #f))
                           (if (= (bytevector-u8-ref source index) 0)
                             (let ((slice (bytevector-copy source last-index index)))
                               (if (not key)
                                 (looper (+ index 1) (+ index 1) slice value)
                                 (looper (+ index 1) (+ index 1) key slice)))
                             (looper (+ index 1) last-index key value)))))))
            (looper 0 0 #f #f))
          result)))

    (define scgi-query-string->list
      (lambda (query-string)
        (let* ((query-bytevector (string->utf8 (string-append query-string "==")))
               (query-bytevector-size (bytevector-length query-bytevector))
               (u8-equal (bytevector-u8-ref (string->utf8 "=") 0))
               (u8-and (bytevector-u8-ref (string->utf8 "&") 0)))
          (letrec ((looper (lambda (index)
                             (if (< index query-bytevector-size)
                               (begin
                                 (if (or (= (bytevector-u8-ref query-bytevector index) u8-equal)
                                         (= (bytevector-u8-ref query-bytevector index) u8-and))
                                   (bytevector-u8-set! query-bytevector index 0))
                                 (looper (+ index 1)))))))
            (looper 0))
          (scgi-split-by-zero->list query-bytevector))))

    (define scgi-netstring->list
      (lambda (netstring)
        (let ((request (list)))
          (letrec ((get-request
                     (lambda (index)
                       (if (= (bytevector-u8-ref netstring index) 58)
                         (bytevector-copy netstring (+ index 1))
                         (get-request (+ index 1))))))
            (if (> (bytevector-length netstring) 0)
              (scgi-split-by-zero->list (get-request 0))
              (list))))))


    (define scgi-get-request-body
      (lambda (request-bytes content-length)
        (letrec ((looper
                   (lambda (index)
                     (if (and (> (bytevector-length request-bytes) 0)
                              (= (bytevector-u8-ref request-bytes index) 0)
                              (= (bytevector-u8-ref request-bytes (+ index 1)) 44))
                       (utf8->string (bytevector-copy request-bytes (+ index 2)))
                       (looper (- index 1))))))
          (looper (- (bytevector-length request-bytes) 1)))))

    (define read-all-from-socket
      (lambda (socket result)
        (let ((bytes (socket-recv socket 4000)))
          (if (< (bytevector-length bytes) 4000)
            (bytevector-append result bytes)
            (read-all-from-socket socket (bytevector-append result bytes))))))

    (define scgi-handle
      (lambda (client-socket handler)
        (let* ((request-bytes (read-all-from-socket client-socket (make-bytevector 0)))
               (request (scgi-netstring->list request-bytes))
               (request-method (if (not (null? request)) (cdr (assoc 'REQUEST_METHOD request)) ""))
               (request-uri (if (not (null? request)) (cdr (assoc 'REQUEST_URI request)) ""))
               (content-length (if (not (null? request)) (string->number (cdr (assoc 'CONTENT_LENGTH request))) 0))
               (body (url-decode (if (> content-length 0) (scgi-get-request-body request-bytes content-length) ""))))
          (set! request (append request (list (cons 'BODY body))))
          (call-with-current-continuation
            (lambda (k)
              (with-exception-handler
                (lambda (ex)
                  (display "ERROR: " (current-error-port))
                  (newline (current-error-port))
                  (display request-uri (current-error-port))
                  (newline (current-error-port))
                  (display (error-object-message ex) (current-error-port))
                  (newline (current-error-port))
                  (display (error-object-irritants ex) (current-error-port))
                  (newline (current-error-port))
                  (write ex (current-error-port))
                  (newline (current-error-port))
                  (k 'exception))
                (lambda ()
                  (for-each
                    (lambda (middleware-procedure)
                      (set! request (middleware-procedure request)))
                    request-middleware)
                  (let ((response (handler request)))
                    (for-each
                      (lambda (middleware-procedure)
                        (set! response (middleware-procedure response)))
                      response-middleware)
                    (socket-send client-socket
                                 (string->utf8 (if (string? response)
                                                 response
                                                 "")))))))))
        (socket-close client-socket)))

    (define scgi-listen
      (lambda (socket handler)
        (scgi-handle (socket-accept socket) handler)
        (scgi-listen socket handler)))

    (define scgi-start
      (lambda (port handler)
        (let ((socket (make-server-socket port)))
          (scgi-listen socket handler))))

    (define scgi-add-request-middleware
      (lambda (middleware-procedure)
        (set! request-middleware (append request-middleware (list middleware-procedure)))))

    (define scgi-add-response-middleware
      (lambda (middleware-procedure)
        (set! response-middleware (append response-middleware (list middleware-procedure)))))

    (define scgi-add-response-and-request-middleware
      (lambda (middleware-procedure)
        (set! request-middleware (append request-middleware (list middleware-procedure)))
        (set! response-middleware (append response-middleware (list middleware-procedure)))))))

A test/scgiclient/src/main.scm => test/scgiclient/src/main.scm +37 -0
@@ 0,0 1,37 @@
(import (scheme base)
        (scheme write)
        (scheme process-context)
        (retropikzel scgi v0-3-0 main)
        ;(srfi 106)
        )

(display "Scgi starting...")
(newline)

(define no-endpoint-handler
  (lambda (request)
    (string-append "Content-type: text/html"
                   "\r\n"
                   "\r\n"
                   "No such endpoint")))

(define hello-handler
  (lambda (request)
    (string-append ;"Content-type: text/html"
                   ;"\r\n"
                   ;"\r\n"
                   "Hello world from Scheme SCGI server")))

(define main
  (lambda (request)
    (display request)
    (newline)
    (let ((request-uri (cdr (assoc 'REQUEST_URI request))))
      (cond ((string=? request-uri "/hello")
             (hello-handler request))
            (else (no-endpoint-handler request))))))

(define port (list-ref (command-line) 1))

(scgi-start port main)