summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c/Makefile.am3
-rw-r--r--src/c/Makefile.in15
-rw-r--r--src/c/static.c56
-rw-r--r--src/main.mlton.sml13
-rw-r--r--src/sources6
-rw-r--r--src/static.sig30
-rw-r--r--src/static.sml41
-rw-r--r--src/tutorial.sig32
-rw-r--r--src/tutorial.sml202
9 files changed, 390 insertions, 8 deletions
diff --git a/src/c/Makefile.am b/src/c/Makefile.am
index 04fe6bf0..467e75cb 100644
--- a/src/c/Makefile.am
+++ b/src/c/Makefile.am
@@ -1,9 +1,10 @@
-lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la
+lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la liburweb_static.la
liburweb_la_SOURCES = memmem.c openssl.c urweb.c request.c queue.c
liburweb_http_la_SOURCES = http.c
liburweb_cgi_la_SOURCES = cgi.c
liburweb_fastcgi_la_SOURCES = fastcgi.c
+liburweb_static_la_SOURCES = static.c
AM_CPPFLAGS = -I../../include @OPENSSL_INCLUDES@
AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security
diff --git a/src/c/Makefile.in b/src/c/Makefile.in
index ad8c1115..4b567a16 100644
--- a/src/c/Makefile.in
+++ b/src/c/Makefile.in
@@ -83,6 +83,9 @@ liburweb_fastcgi_la_OBJECTS = $(am_liburweb_fastcgi_la_OBJECTS)
liburweb_http_la_LIBADD =
am_liburweb_http_la_OBJECTS = http.lo
liburweb_http_la_OBJECTS = $(am_liburweb_http_la_OBJECTS)
+liburweb_static_la_LIBADD =
+am_liburweb_static_la_OBJECTS = static.lo
+liburweb_static_la_OBJECTS = $(am_liburweb_static_la_OBJECTS)
DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
depcomp = $(SHELL) $(top_srcdir)/depcomp
am__depfiles_maybe = depfiles
@@ -97,9 +100,11 @@ LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \
$(LDFLAGS) -o $@
SOURCES = $(liburweb_la_SOURCES) $(liburweb_cgi_la_SOURCES) \
- $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES)
+ $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES) \
+ $(liburweb_static_la_SOURCES)
DIST_SOURCES = $(liburweb_la_SOURCES) $(liburweb_cgi_la_SOURCES) \
- $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES)
+ $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES) \
+ $(liburweb_static_la_SOURCES)
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
@@ -231,11 +236,12 @@ target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
-lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la
+lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la liburweb_static.la
liburweb_la_SOURCES = memmem.c openssl.c urweb.c request.c queue.c
liburweb_http_la_SOURCES = http.c
liburweb_cgi_la_SOURCES = cgi.c
liburweb_fastcgi_la_SOURCES = fastcgi.c
+liburweb_static_la_SOURCES = static.c
AM_CPPFLAGS = -I../../include @OPENSSL_INCLUDES@
AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security
all: all-am
@@ -311,6 +317,8 @@ liburweb_fastcgi.la: $(liburweb_fastcgi_la_OBJECTS) $(liburweb_fastcgi_la_DEPEND
$(LINK) -rpath $(libdir) $(liburweb_fastcgi_la_OBJECTS) $(liburweb_fastcgi_la_LIBADD) $(LIBS)
liburweb_http.la: $(liburweb_http_la_OBJECTS) $(liburweb_http_la_DEPENDENCIES)
$(LINK) -rpath $(libdir) $(liburweb_http_la_OBJECTS) $(liburweb_http_la_LIBADD) $(LIBS)
+liburweb_static.la: $(liburweb_static_la_OBJECTS) $(liburweb_static_la_DEPENDENCIES)
+ $(LINK) -rpath $(libdir) $(liburweb_static_la_OBJECTS) $(liburweb_static_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
@@ -325,6 +333,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openssl.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/queue.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/request.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/static.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/urweb.Plo@am__quote@
.c.o:
diff --git a/src/c/static.c b/src/c/static.c
new file mode 100644
index 00000000..76b04e45
--- /dev/null
+++ b/src/c/static.c
@@ -0,0 +1,56 @@
+#include "config.h"
+
+#include <stdio.h>
+#include <stdarg.h>
+
+#include "urweb.h"
+
+extern uw_app uw_application;
+
+static void log_debug(void *data, const char *fmt, ...) {
+ va_list ap;
+ va_start(ap, fmt);
+
+ vprintf(fmt, ap);
+}
+
+int main(int argc, char *argv[]) {
+ uw_context ctx;
+ failure_kind fk;
+
+ if (argc != 2) {
+ fprintf(stderr, "Pass exactly one argument: the URI to run\n");
+ return 1;
+ }
+
+ ctx = uw_init(0, NULL, log_debug);
+ uw_set_app(ctx, &uw_application);
+ fk = uw_begin(ctx, argv[1]);
+
+ if (fk == SUCCESS) {
+ uw_print(ctx, 1);
+ puts("");
+ return 0;
+ } else {
+ fprintf(stderr, "Error!\n");
+ return 1;
+ }
+}
+
+void *uw_init_client_data() {
+ return NULL;
+}
+
+void uw_free_client_data(void *data) {
+}
+
+void uw_copy_client_data(void *dst, void *src) {
+}
+
+void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) {
+}
+
+void uw_post_expunge(uw_context ctx, void *data) {
+}
+
+int uw_supports_direct_status = 0;
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 06c04366..0c6f96ba 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2011, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -29,6 +29,7 @@ val timing = ref false
val tc = ref false
val sources = ref ([] : string list)
val demo = ref (NONE : (string * bool) option)
+val tutorial = ref false
val css = ref false
fun doArgs args =
@@ -43,6 +44,9 @@ fun doArgs args =
| "-guided-demo" :: prefix :: rest =>
(demo := SOME (prefix, true);
doArgs rest)
+ | "-tutorial" :: rest =>
+ (tutorial := true;
+ doArgs rest)
| "-protocol" :: name :: rest =>
(Settings.setProtocol name;
doArgs rest)
@@ -118,8 +122,8 @@ val job =
| _ => raise Fail "Zero or multiple job files specified"
val () =
- case (!css, !demo) of
- (true, _) =>
+ case (!css, !demo, !tutorial) of
+ (true, _, _) =>
(case Compiler.run Compiler.toCss job of
NONE => OS.Process.exit OS.Process.failure
| SOME {Overall = ov, Classes = cl} =>
@@ -131,8 +135,9 @@ val () =
app (print o Css.inheritableToString) ins;
app (print o Css.othersToString) ots;
print "\n")) cl))
- | (_, SOME (prefix, guided)) =>
+ | (_, SOME (prefix, guided), _) =>
Demo.make {prefix = prefix, dirname = job, guided = guided}
+ | (_, _, true) => Tutorial.make job
| _ =>
if !tc then
(Compiler.check Compiler.toElaborate job;
diff --git a/src/sources b/src/sources
index 3efdecb4..ebc2ab13 100644
--- a/src/sources
+++ b/src/sources
@@ -28,6 +28,9 @@ cgi.sml
fastcgi.sig
fastcgi.sml
+static.sig
+static.sml
+
mysql.sig
mysql.sml
@@ -209,3 +212,6 @@ compiler.sml
demo.sig
demo.sml
+
+tutorial.sig
+tutorial.sml
diff --git a/src/static.sig b/src/static.sig
new file mode 100644
index 00000000..f809a6d0
--- /dev/null
+++ b/src/static.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature STATIC = sig
+
+end
diff --git a/src/static.sml b/src/static.sml
new file mode 100644
index 00000000..fa3205c1
--- /dev/null
+++ b/src/static.sml
@@ -0,0 +1,41 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Static :> STATIC = struct
+
+open Settings
+open Print.PD Print
+
+val () = addProtocol {name = "static",
+ compile = "",
+ linkStatic = Config.lib ^ "/../liburweb_static.a",
+ linkDynamic = "-lurweb_static",
+ persistent = false,
+ code = fn () => box [string "void uw_global_custom() { }",
+ newline]}
+
+end
diff --git a/src/tutorial.sig b/src/tutorial.sig
new file mode 100644
index 00000000..cda9b01c
--- /dev/null
+++ b/src/tutorial.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature TUTORIAL = sig
+
+ val make : string -> unit
+
+end
diff --git a/src/tutorial.sml b/src/tutorial.sml
new file mode 100644
index 00000000..dad0a1ea
--- /dev/null
+++ b/src/tutorial.sml
@@ -0,0 +1,202 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Tutorial :> TUTORIAL = struct
+
+fun readAll' inf =
+ let
+ fun loop acc =
+ case TextIO.inputLine inf of
+ NONE => Substring.full (String.concat (rev acc))
+ | SOME line => loop (line :: acc)
+ in
+ loop []
+ before TextIO.closeIn inf
+ end
+
+fun readAll fname = readAll' (TextIO.openIn fname)
+
+fun doUr fname =
+ let
+ val eval = TextIO.openOut "/tmp/eval.ur"
+ val gen = TextIO.openOut "/tmp/gen.ur"
+
+ fun untilEnd source =
+ let
+ val (befor, after) = Substring.position "(* end *)" source
+ in
+ if Substring.isEmpty after then
+ (source, Substring.full "")
+ else
+ (befor, Substring.slice (after, 9, NONE))
+ end
+
+ fun doDirectives (count, source) =
+ let
+ val safe = String.translate (fn #"<" => "&lt;"
+ | #"&" => "&amp;"
+ | #"{" => "&#123;"
+ | #"(" => "&#40;"
+ | #"\n" => "&#40;*NL*)\n"
+ | ch => str ch) o Substring.string
+
+ val (befor, after) = Substring.position "(* begin " source
+
+ fun default () = (TextIO.outputSubstr (eval, source);
+ TextIO.output (gen, safe source))
+ in
+ if Substring.isEmpty after then
+ default ()
+ else
+ let
+ val (command, after) = Substring.splitl (not o Char.isSpace) (Substring.slice (after, 9, NONE))
+ in
+ if Substring.isEmpty after then
+ default ()
+ else
+ let
+ val (_, rest) = Substring.position "*)" after
+ in
+ if Substring.isEmpty rest then
+ default ()
+ else
+ let
+ val (arg, source) = untilEnd (Substring.slice (rest, 3, NONE))
+ val () = (TextIO.outputSubstr (eval, befor);
+ TextIO.output (gen, safe befor))
+ val (count, skip) =
+ case Substring.string command of
+ "hide" => (TextIO.outputSubstr (eval, arg);
+ (count, true))
+ | "eval" => (TextIO.output (eval, "val _eval");
+ TextIO.output (eval, Int.toString count);
+ TextIO.output (eval, " = ");
+ TextIO.outputSubstr (eval, arg);
+ TextIO.output (eval, "\n\n");
+
+ TextIO.output (gen, safe arg);
+ TextIO.output (gen, "== {[_eval");
+ TextIO.output (gen, Int.toString count);
+ TextIO.output (gen, "]}");
+
+ (count + 1, false))
+ | s => raise Fail ("Unknown tutorial directive: " ^ s)
+ in
+ doDirectives (count, if skip then
+ #2 (Substring.splitl Char.isSpace source)
+ else
+ source)
+ end
+ end
+ end
+ end
+ in
+ doDirectives (0, readAll fname);
+ TextIO.closeOut gen;
+
+ TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>");
+ TextIO.outputSubstr (eval, readAll "/tmp/gen.ur");
+ TextIO.output (eval, "</body></xml>");
+ TextIO.closeOut eval;
+
+ if Compiler.compile "/tmp/eval" then
+ let
+ val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"])
+ val inf = Unix.textInstreamOf proc
+ val s = readAll' inf
+ val _ = Unix.reap proc
+
+ val (befor, after) = Substring.position "<sc>" s
+ in
+ if Substring.isEmpty after then
+ print ("Bad output for " ^ fname ^ "! [1]\n")
+ else
+ let
+ val after = Substring.slice (after, 4, NONE)
+ val (befor, after) = Substring.position "</body>" after
+ in
+ if Substring.isEmpty after then
+ print ("Bad output for " ^ fname ^ "! [2]\n")
+ else
+ let
+ val outf = TextIO.openOut "/tmp/final.ur"
+
+ fun eatNls source =
+ let
+ val (befor, after) = Substring.position "(*NL*)" source
+ in
+ if Substring.isEmpty after then
+ TextIO.outputSubstr (outf, source)
+ else
+ (TextIO.outputSubstr (outf, befor);
+ eatNls (Substring.slice (after, 6, NONE)))
+ end
+
+ val cmd = "emacs --eval \"(progn "
+ ^ "(global-font-lock-mode t) "
+ ^ "(add-to-list 'load-path \\\""
+ ^ Config.sitelisp
+ ^ "/\\\") "
+ ^ "(load \\\"urweb-mode-startup\\\") "
+ ^ "(urweb-mode) "
+ ^ "(find-file \\\"/tmp/final.ur\\\") "
+ ^ "(switch-to-buffer (htmlize-buffer)) "
+ ^ "(write-file \\\""
+ ^ OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
+ path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}}
+ ^ "\\\") "
+ ^ "(kill-emacs))\""
+ in
+ eatNls befor;
+ TextIO.closeOut outf;
+ ignore (OS.Process.system cmd)
+ end
+ end
+ end
+ else
+ ()
+ end
+
+fun make dirname =
+ let
+ val dir = OS.FileSys.openDir dirname
+
+ fun doDir () =
+ case OS.FileSys.readDir dir of
+ NONE => OS.FileSys.closeDir dir
+ | SOME fname =>
+ (if OS.Path.ext fname = SOME "ur" then
+ doUr (OS.Path.joinDirFile {dir = dirname, file = fname})
+ else
+ ();
+ doDir ())
+ in
+ Settings.setProtocol "static";
+ doDir ()
+ end
+
+end