web server

#(ws4t - HTTP multi-threaded Web server for TBPL)
#(Main loop)

io close;

'io;
sys version indexOf "Linux" ++
? { io = CIO open "/var/log/ws4t.log"; }
?? { io = CIO open "ws4t.log"; };
tbpl_io fdwrite = io fdwrite;

'MAX_CONNECTIONS = 16;
'http_server =
{
  thread_wait += 1;
 
  'client_io ~= arg;
  client_io 'EOFError = { "" };
  'request = "";
  request = client_io readline chomp!;
  
  'REQUEST_METHOD = request find: "^[^ ]*";
  'REQUEST_URI = request right(0 - REQUEST_METHOD size + 1) find: "^[^ ]*";
  'REQUEST_PROTOCOL = request find: "[^ ]*$";

  REQUEST_URI[0] == "/" ?? { REQUEST_URI = "/"; };
  'WL_SCRIPT = REQUEST_URI find: "^/[^/\\?]*";
  'QUERY_STRING = REQUEST_URI find: "\\?.*$";
  'WL_PATH = REQUEST_URI left (REQUEST_URI size - QUERY_STRING size) right (0 - WL_SCRIPT size);

  QUERY_STRING right! -1;

  'headers = [];
  'get_data = true;
  get_data while {
    'str = "";
    str = client_io readline chomp!;
    (str match: ": ") && (str size > 0)
       ? { headers create (str find ".*: " left! -2 tolower!) = str find ": .*" right -2; }
      ?? { get_data = false; };
  };

  headers contains "content-length"
  ?? { headers 'content-length = ""; };
  headers contains "host"
  ?? { headers 'host = "kmeaw.com"; };

  'WL_REMOTE = client_io addr host;
  (WL_REMOTE == "192.168.0.1") && (headers contains "x-forwarded-for") ? { WL_REMOTE = headers x-forwarded-for; };
  io outn "\{sys time}> \{REQUEST_METHOD} (\{headers content-length}) \{WL_REMOTE}: \{REQUEST_URI} (\{WL_SCRIPT})";

  (WL_SCRIPT == "") || 
  (WL_SCRIPT == "/")
  ? {
    WL_SCRIPT = "/tref.tbs";
    WL_PATH = ""; 
  };

  (WL_SCRIPT right 4 == ".tbs")
  ? { 
    'WL_VERSION = 0001;
    'WL_PROJECT = WL_SCRIPT left -4 right! -1;
    'WL_CACHE = false;

    % contains WL_PROJECT
     ? { WL_CACHE = true; }
    ?? { lang require: "\{WL_PROJECT}/init.tbs"; };

    % find WL_PROJECT contains "development" && WL_CACHE
    ? { 
      % find WL_PROJECT delete;
      lang require: "\{WL_PROJECT}/init.tbs"; 
    };

    'WL_ROOT ~= % find WL_PROJECT;

    WL_PATH left: 1 == "/"
      ?? { WL_PATH = "/" + WL_PATH; };
    WL_PATH == "/"
      ?  { WL_PATH = ""; };
    WL_PATH right: 1 == "/"
      ?  { WL_PATH left: -1; };
    WL_PATH = WL_PROJECT + WL_PATH replace('to = " "; "/");
    'WL_TARGET ~= CObject expand WL_PATH;

    'WL_GET = [];
    'WL_POST = [];
    'WL_DATA = [];

    'WL_REQUIRE =
    {
      WL_DATA contains arg
      ?? { WL_DATA create: arg = ""; };
      WL_DATA find: arg
    };

    'WL_RAW = client_io :readbytes 0 :valueOf headers content-length;
    {
      'part = WL_RAW find "^[^&]*";

      'left = part;
      'right = "";

      part match "=" ?
      {
	left = part find "^[^=]*";
	right = part find "[^=]*$" urldecode;
      };

      WL_POST create: left = right;
      WL_DATA create: left = right;

      WL_RAW :right! 0 :- part size;
      WL_RAW left: 1 == "&" ? { WL_RAW right! -1; };
    } while { WL_RAW size > 0 };

    'WL_RAW = QUERY_STRING;
    {
      'part = WL_RAW find "^[^&]*";

      'left = part;
      'right = "";

      part match "=" ?
      {
	left = part find "^[^=]*";
	right = part find "[^=]*$" urldecode;
      };

      WL_GET create: left = right;
      WL_DATA create: left = right;

      WL_RAW :right! 0 :- part size;
      WL_RAW left: 1 == "&" ? { WL_RAW right! -1; };
    } while { WL_RAW size > 0 };

    'text = "";
    &WL_TARGET respondsTo "toWeb"
      ? { 
      text = "HTTP/1.0 200 OK
Connection: close
Server: ws4t 0.2
";
    text += &WL_TARGET toWeb;
	}
     ?? { 
      text = "HTTP/1.0 404 Not Found
Connection: close
Server: ws4t 0.2
Content-Type: text/html

Error in \{&WL_TARGET path}.";
       };

    client_io out text;
  }
  ?? {
    (REQUEST_URI match "\\.\\.\\/")
    ? {
      client_io outn "HTTP/1.0 403 Forbidden";
      client_io outn "Server: ws4t 0.2\n";
      client_io outn "Breaking into this server is forbidden, sorry.";
      client_io close;
    }
    ?? {
      CIO exist ("./" += REQUEST_URI)
      ? {
        'file_io = CIO :open "./" += REQUEST_URI;
        client_io outn "HTTP/1.0 200 OK";
	'data = file_io readlines;
	'stat = CStat :new "./" += REQUEST_URI;
	client_io outn "Content-Length: \{data size}";
	client_io outn "Last-Modified: \{sys :time_rfc stat mtime}";
        client_io outn "Server: ws4t\n";
        client_io :out data;
        file_io close;
      }
      ?? {
        client_io outn "HTTP/1.0 400 Not Found";
        client_io outn "Server: ws4t\n";
        client_io outn "The file or resource you have requested does not exist...";
      };
    };
  };

  sys sleep 100000;
  client_io flush;
  client_io close;

  thread_wait -= 1;
};

#{Create a socket}

'socket = CSocket new;
socket bind <tcp://*:3000>;
socket listen;


sys version indexOf "Linux" ++
? {
 'pidfile = CIO open "/var/run/ws4t.pid";
  pidfile :out sys getpid;
  pidfile close;

  sys  setgid 1010;
  sys  setuid  101;
  sys exec "id";
};

*thread_wait = 0;
'server_thread = true;
'socket_down = false;

{
  server_thread while 
  { 
    { 
      io outn "\{sys time}> [WRN] DoS attack detected!";
      sys sleep: 1000000; 
    } while { thread_wait > MAX_CONNECTIONS };
    'user_socket = socket accept;
    user_socket class equals CSocket ?
    {
      server_thread
       ? { &http_server :thread user_socket dup; }
      ?? { 
	user_socket close; 
	socket_down = true;
      };
    };
    sys sleep: 10000;
  };
  socket close;
} thread;

io outn "\{sys time}> Server started.";
sys version indexOf "Linux" ++
 ? {
  sys chdir "/var/www/localhost/htdocs";
  CIO exist "/var/run/ws4t.ctl"
  ?? { io outn: "\{sys time}> Control FIFO not found, aborting..."; }
   ? { CIO open: "/var/run/ws4t.ctl" readline; };
 }
?? { true while { sys sleep: 10000000; }; };

server_thread = false;

io outn "\{sys time}> Waiting all connections to close...";
{
  io outn "\{sys time}> \{thread_wait} connections pending.";
  sys sleep 1000000;
} while { thread_wait > 0 };

io outn "\{sys time}> Shutting down main thread...";
socket_down ?? { CSocket new connect: <tcp://127.0.0.1:80> close; };

io outn "\{sys time}> Server down.";
io close;