More

diff --git a/serve.pl b/serve.pl
index 87f5329cc5133c46e9eb3eba6342807c0b2a7b4b..bb6df47d904c019f800aaeab8dfe5438101206c8 100644 (file)
--- a/serve.pl
+++ b/serve.pl
@@ -1,4 +1,4 @@
-:- module(serve, [serve/3]).
+:- module(serve, [serve/4]).
 
 :- use_module(library(dcgs)).
 :- use_module(config).
@@ -6,21 +6,22 @@
 :- use_module(library(iso_ext)).
 :- use_module(library(lists)).
 :- use_module(library(pio)).
+:- use_module(library(charsio)).
 :- use_module(library(sockets)).
+:- use_module(library(debug)).
 :- use_module(log).
 :- use_module(mime).
 :- use_module(response).
 
-%% serve(+Stream, +Path, +Query)
+%% serve(+Stream, +Root, +Path, -Query)
 %
 % Serve the file at Path to Stream
-serve(S, /, Q) :-
-    serve(S, '/index.gmi', Q).
-serve(S, Path, _) :-
+serve(S, Root, /, Q) :-
+    serve(S, Root, '/index.gmi', Q).
+serve(S, Root, Path, _) :-
     atom_chars(Path, Chars),
     (  is_absolute(Chars)
     -> guess_mime(Chars, Mime),
-       content(Root),
        append(Root, Chars, File),
        (  file_exists(File)
        -> log_msg("response", "File does exist~n", []),
@@ -58,10 +59,19 @@ serve_binary(S, Mime, File) :-
             phrase(response(success, Mime), Response0),
             format(S, "~s", [Response0]),
             open(stream(S), write, _, [type(binary)]),
-            catch(copy_stream(FileStream, S),
+            catch(src_dest(FileStream, S),
                   error(existence_error(stream, _), _),
                   log_msg("response", "Client disconnected mid-stream~n", [])),
             log_msg("response", "Sent binary response~n", [])
         ),
         close(FileStream)
       ).
+
+src_dest(FileStream, DestStream) :-
+    get_n_chars(FileStream, 4096, Chars),
+    ( Chars = [] -> true
+    ; phrase_to_stream(seq(Chars), DestStream),
+      false).
+
+src_dest(FileStream, DestStream) :-
+    src_dest(FileStream, DestStream).

diff --git a/sula.pl b/sula.pl
index 7ce3d32a57a8e35723ad25672dbef74e8e9fcbc5..086416fb0d71ff3e1afa577e8f042d522f7b6b69 100755 (executable)
--- a/sula.pl
+++ b/sula.pl
@@ -118,5 +118,6 @@ handle_conn_error(Error) :-
 req_serve(S, ClientCert) :-
     read_request(S, Path, Query),
     save_client(ClientCert),
-    serve(S, Path, Query),
+    content(Root),
+    serve(S, Root, Path, Query),
     !.