├── .github ├── dependabot.yml └── workflows │ └── workflow.yml ├── .gitignore ├── .ocamlformat ├── .ocamlformat-ignore ├── .ocp-indent ├── CHANGES ├── CODE_OF_CONDUCT.md ├── COPYING ├── LICENSE ├── Makefile ├── Makefile.dist ├── Makefile.options ├── README.md ├── VERSION ├── configure ├── doc ├── Makefile └── indexdoc ├── dune ├── dune-project ├── local └── var │ └── www │ ├── index.html │ └── ocsigenstuff │ ├── AUTHORS │ ├── COPYING │ ├── back.png │ ├── cdimage.png │ ├── deb.png │ ├── dvi.png │ ├── folder_open.png │ ├── html.png │ ├── image.png │ ├── ocsigen5.png │ ├── pdf.png │ ├── postscript.png │ ├── readme.png │ ├── rpm.png │ ├── scalable │ ├── application-pdf.svgz │ ├── application-postscript.svgz │ ├── application-rtf.svgz │ ├── application-vnd.oasis.opendocument.presentation.svgz │ ├── application-x-cd-image.svgz │ ├── application-x-deb.svgz │ ├── application-x-mswinurl.svgz │ ├── application-x-perl.svgz │ ├── application-x-rpm.svgz │ ├── application-x-tar.svgz │ ├── application-x-tarz.svgz │ ├── audio-ac3.svgz │ ├── document-open-folder.svgz │ ├── draw-arrow-back.svgz │ ├── image-x-generic.svgz │ ├── mixer-video.svgz │ ├── text-plain.svgz │ ├── text-x-csrc.svgz │ ├── text-x-java.svgz │ ├── text-x-python.svgz │ ├── text-x-tex.svgz │ └── unknown.svgz │ ├── sound.png │ ├── source_c.png │ ├── source_java.png │ ├── source_pl.png │ ├── source_py.png │ ├── style.css │ ├── tar.png │ ├── tex.png │ ├── tgz.png │ ├── txt.png │ ├── unknown.png │ └── video.png ├── ocsigenserver.opam ├── ocsigenserver.opam.template ├── src ├── baselib │ ├── dune │ ├── dynlink_wrapper.natdynlink.ml │ ├── dynlink_wrapper.nonatdynlink.ml │ ├── ocsigen_cache.ml │ ├── ocsigen_cache.mli │ ├── ocsigen_config_static.ml.in │ ├── ocsigen_config_static.mli │ ├── ocsigen_lib.ml │ ├── ocsigen_lib.mli │ ├── ocsigen_lib_base.ml │ ├── ocsigen_lib_base.mli │ ├── ocsigen_loader.ml │ ├── ocsigen_loader.mli │ ├── ocsigen_stream.ml │ ├── ocsigen_stream.mli │ ├── polytables │ │ ├── Makefile │ │ ├── dune │ │ ├── polytables.ml │ │ └── polytables.mli │ └── tests │ │ └── test_wrapping.ml ├── dune ├── extensions │ ├── accesscontrol.ml │ ├── accesscontrol.mli │ ├── authbasic.ml │ ├── authbasic.mli │ ├── cors.ml │ ├── cors.mli │ ├── deflatemod.ml │ ├── deflatemod.mli │ ├── dune │ ├── extendconfiguration.ml │ ├── extendconfiguration.mli │ ├── outputfilter.ml │ ├── outputfilter.mli │ ├── redirectmod.ml │ ├── redirectmod.mli │ ├── revproxy.ml │ ├── revproxy.mli │ ├── rewritemod.ml │ ├── rewritemod.mli │ ├── staticmod.ml │ ├── staticmod.mli │ ├── userconf.ml │ └── userconf.mli ├── files │ ├── logrotate.in │ ├── mime.types │ ├── ocsigenserver.1 │ └── ocsigenserver.conf │ │ ├── dune │ │ ├── gen.ml │ │ └── options.ml ├── http │ ├── dune │ ├── ocsigen_charset_mime.ml │ ├── ocsigen_charset_mime.mli │ ├── ocsigen_cookie_map.ml │ ├── ocsigen_cookie_map.mli │ ├── ocsigen_header.ml │ └── ocsigen_header.mli ├── ocsigenserver.ml └── server │ ├── Makefile │ ├── dune │ ├── ocsigen_cohttp.ml │ ├── ocsigen_cohttp.mli │ ├── ocsigen_command.ml │ ├── ocsigen_command.mli │ ├── ocsigen_config.ml │ ├── ocsigen_config.mli │ ├── ocsigen_extensions.ml │ ├── ocsigen_extensions.mli │ ├── ocsigen_local_files.ml │ ├── ocsigen_local_files.mli │ ├── ocsigen_messages.ml │ ├── ocsigen_messages.mli │ ├── ocsigen_multipart.ml │ ├── ocsigen_multipart.mli │ ├── ocsigen_parseconfig.ml │ ├── ocsigen_parseconfig.mli │ ├── ocsigen_request.ml │ ├── ocsigen_request.mli │ ├── ocsigen_response.ml │ ├── ocsigen_response.mli │ ├── ocsigen_server.ml │ └── ocsigen_server.mli └── test ├── dune ├── extensions └── deflatemod.t │ ├── dune │ ├── dune-project │ ├── index.html │ ├── run.t │ └── test.ml └── server-test-helpers.sh /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: github-actions 4 | directory: / 5 | schedule: 6 | interval: weekly 7 | -------------------------------------------------------------------------------- /.github/workflows/workflow.yml: -------------------------------------------------------------------------------- 1 | name: Builds, tests & co 2 | 3 | on: 4 | push: 5 | pull_request: 6 | schedule: 7 | # Prime the caches every Monday 8 | - cron: 0 1 * * MON 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | build: 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | os: 18 | - ubuntu-latest 19 | - ubuntu-24.04-arm 20 | - macos-latest 21 | - windows-latest 22 | ocaml-compiler: 23 | - 5 24 | - 4 25 | include: 26 | - os: ubuntu-latest 27 | ocaml-compiler: "4.08" 28 | 29 | runs-on: ${{ matrix.os }} 30 | 31 | steps: 32 | - name: Set git to use LF 33 | if: matrix.os == 'windows-latest' 34 | run: | 35 | git config --global core.autocrlf false 36 | git config --global core.eol lf 37 | git config --global core.ignorecase false 38 | 39 | - name: Checkout tree 40 | uses: actions/checkout@v4 41 | 42 | - name: Set-up OCaml 43 | uses: ocaml/setup-ocaml@v3 44 | with: 45 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 46 | 47 | - run: opam install . --deps-only 48 | 49 | - run: opam exec -- bash ./configure 50 | 51 | - run: opam exec -- make all 52 | 53 | # lint-doc: 54 | # runs-on: ubuntu-latest 55 | # steps: 56 | # - name: Checkout tree 57 | # uses: actions/checkout@v4 58 | # - name: Set-up OCaml 59 | # uses: ocaml/setup-ocaml@v3 60 | # with: 61 | # ocaml-compiler: 5 62 | # - run: opam install . --deps-only 63 | # - run: opam exec -- bash ./configure 64 | # - run: opam exec -- make all 65 | # - uses: ocaml/setup-ocaml/lint-doc@v3 66 | 67 | lint-fmt: 68 | runs-on: ubuntu-latest 69 | steps: 70 | - name: Checkout tree 71 | uses: actions/checkout@v4 72 | - name: Set-up OCaml 73 | uses: ocaml/setup-ocaml@v3 74 | with: 75 | ocaml-compiler: 5 76 | - run: opam install . --deps-only 77 | - run: opam exec -- bash ./configure 78 | - run: opam exec -- make all 79 | - uses: ocaml/setup-ocaml/lint-fmt@v3 80 | 81 | # lint-opam: 82 | # runs-on: ubuntu-latest 83 | # steps: 84 | # - name: Checkout tree 85 | # uses: actions/checkout@v4 86 | # - name: Set-up OCaml 87 | # uses: ocaml/setup-ocaml@v3 88 | # with: 89 | # ocaml-compiler: 5 90 | # - run: opam install . --deps-only 91 | # - run: opam exec -- bash ./configure 92 | # - run: opam exec -- make all 93 | # - uses: ocaml/setup-ocaml/lint-opam@v3 94 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | Makefile.config 3 | src/baselib/dynlink_wrapper.ml 4 | src/baselib/ocsigen_config_static.ml 5 | ocsigenserver.conf.sample 6 | ocsigenserver.conf.opt.sample 7 | local 8 | doc/api-html 9 | doc/api-wiki 10 | _opam 11 | _build 12 | .vscode 13 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.27.0 2 | break-cases=fit 3 | break-collection-expressions=fit-or-vertical 4 | break-fun-decl=wrap 5 | break-fun-sig=wrap 6 | break-infix-before-func=false 7 | break-infix=wrap 8 | break-separators=before 9 | break-sequences=false 10 | break-string-literals=never 11 | break-struct=force 12 | cases-matching-exp-indent=compact 13 | doc-comments=after-when-possible 14 | dock-collection-brackets=false 15 | field-space=loose 16 | if-then-else=keyword-first 17 | indicate-multiline-delimiters=no 18 | infix-precedence=indent 19 | let-and=compact 20 | let-binding-spacing=compact 21 | module-item-spacing=compact 22 | ocp-indent-compat=true 23 | parens-tuple-patterns=multi-line-only 24 | parens-tuple=multi-line-only 25 | parse-docstrings=false 26 | sequence-blank-line=compact 27 | sequence-style=terminator 28 | single-case=compact 29 | space-around-arrays=false 30 | space-around-lists=false 31 | space-around-records=false 32 | space-around-variants=false 33 | type-decl=compact 34 | -------------------------------------------------------------------------------- /.ocamlformat-ignore: -------------------------------------------------------------------------------- 1 | src/baselib/ocsigen_config_static.ml 2 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | normal 2 | with=0 3 | syntax=lwt mll 4 | max_indent=2 5 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Code of Conduct 2 | 3 | This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md). 4 | 5 | # Enforcement 6 | 7 | This project follows the OCaml Code of Conduct [enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement). 8 | 9 | To report any violations, please contact Jérôme 10 | Vouillon, Raphael Proust, Vincent Balat, Hugo Heuzard and Gabriel 11 | Radanne at 12 | (or some of them individually). 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Ocsigen application core, and other portions of the official Ocsigen 2 | distribution not explicitly licensed otherwise, are licensed under 3 | the GNU LESSER GENERAL PUBLIC LICENSE with openssl linking exception 4 | -- see the 'COPYING' file in this directory for details. 5 | 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include Makefile.config 2 | include Makefile.options 3 | 4 | ### Building 5 | 6 | .PHONY: default all doc 7 | default all: build 8 | 9 | .PHONY: build 10 | build: 11 | dune build -p ocsigenserver 12 | ${MAKE} -C src/server build 13 | doc: 14 | $(MAKE) -C doc 15 | 16 | ### Testing : local execution and toplevel ### 17 | 18 | .PHONY: run.local run.opt.local top 19 | 20 | run.local: build install.files 21 | CAML_LD_LIBRARY_PATH=${BLD}/server:$(CAML_LD_LIBRARY_PATH) ${BLD}/ocsigenserver.bc -c local/etc/ocsigenserver.conf 22 | 23 | run.opt.local: build install.files 24 | CAML_LD_LIBRARY_PATH=${BLD}/server:$(CAML_LD_LIBRARY_PATH) ${BLD}/ocsigenserver.exe -c local/etc/ocsigenserver.conf 25 | 26 | top: 27 | cd src/server && ${MAKE} top 28 | 29 | ### Cleaning ### 30 | 31 | clean: clean.local 32 | ${MAKE} -C src/server clean 33 | 34 | clean.local: 35 | dune clean 36 | -rm -f ocsigenserver-*.tar.gz 37 | 38 | distclean: clean.local 39 | ${MAKE} -C src/server distclean 40 | -make -C doc clean 41 | -rm Makefile.config 42 | -rm -f *~ \#* .\#* 43 | 44 | ### Installation #### 45 | 46 | .PHONY: purge.files install.files 47 | 48 | # BB If install is not run by root but OCSIGENUSER, OCSIGENGROUP is somebody 49 | # BB different, make files universally accessible, we cannot chown. 50 | INSTALL_CAN_PUT_PERMISSIONS=yes 51 | INSTALL_USER_GROUP=-o $(OCSIGENUSER) -g "$(OCSIGENGROUP)" 52 | INSTALL_MOD_660=660 53 | INSTALL_MOD_644=644 54 | INSTALL_MOD_755=755 55 | INSTALL_MOD_770=770 56 | INSTALL_MOD_750=750 57 | USERNAME=$(shell whoami) 58 | ifneq ($(shell id -u), 0) 59 | ifneq ($(OCSIGENUSER), $(USERNAME)) 60 | INSTALL_CAN_PUT_PERMISSIONS=no 61 | endif 62 | ifneq ($(shell groups ${USERNAME}|grep -q ${OCSIGENGROUP}; echo $$?), 0) 63 | INSTALL_CAN_PUT_PERMISSIONS=no 64 | endif 65 | endif 66 | ifeq ($(INSTALL_CAN_PUT_PERMISSIONS), no) 67 | INSTALL_USER_GROUP= 68 | INSTALL_MOD_660=666 69 | INSTALL_MOD_644=666 70 | INSTALL_MOD_755=777 71 | INSTALL_MOD_770=777 72 | INSTALL_MOD_750=777 73 | endif 74 | 75 | install.files: 76 | @echo 77 | @echo "## Run \"make doc\" and \"make install.doc\" to build and install the ocamldoc." 78 | @echo INSTALL_CAN_PUT_PERMISSIONS: ${INSTALL_CAN_PUT_PERMISSIONS} 79 | ## Configuration files 80 | $(INSTALL) -m ${INSTALL_MOD_755} -d $(TEMPROOT)$(CONFIGDIR)/conf.d 81 | ${INSTALL} -m ${INSTALL_MOD_644} _build/install/default/etc/ocsigenserver/ocsigenserver.conf.sample $(TEMPROOT)$(CONFIGDIR)/ 82 | [ -f $(TEMPROOT)$(CONFIGDIR)/ocsigenserver.conf ] || \ 83 | { $(INSTALL) -m ${INSTALL_MOD_644} _build/install/default/etc/ocsigenserver/ocsigenserver.conf.sample \ 84 | $(TEMPROOT)$(CONFIGDIR)/ocsigenserver.conf; } 85 | -mv $(TEMPROOT)$(CONFIGDIR)/mime.types $(TEMPROOT)$(CONFIGDIR)/mime.types.old 86 | ## Log directory 87 | $(INSTALL) -m ${INSTALL_MOD_644} src/files/mime.types $(TEMPROOT)$(CONFIGDIR) 88 | $(INSTALL) -d -m ${INSTALL_MOD_755} ${INSTALL_USER_GROUP} $(TEMPROOT)$(LOGDIR) 89 | ## Static files 90 | $(INSTALL) -d -m ${INSTALL_MOD_755} ${INSTALL_USER_GROUP} $(TEMPROOT)$(STATICPAGESDIR) 91 | $(INSTALL) -d -m ${INSTALL_MOD_750} ${INSTALL_USER_GROUP} $(TEMPROOT)$(DATADIR) 92 | $(INSTALL) -m ${INSTALL_MOD_644} ${INSTALL_USER_GROUP} \ 93 | local/var/www/*.html $(TEMPROOT)$(STATICPAGESDIR) 94 | $(INSTALL) -d -m ${INSTALL_MOD_755} ${INSTALL_USER_GROUP} \ 95 | $(TEMPROOT)$(STATICPAGESDIR)/ocsigenstuff 96 | $(INSTALL) -m ${INSTALL_MOD_644} ${INSTALL_USER_GROUP} \ 97 | local/var/www/ocsigenstuff/*.png local/var/www/ocsigenstuff/*.css \ 98 | $(TEMPROOT)$(STATICPAGESDIR)/ocsigenstuff 99 | $(INSTALL) -d -m ${INSTALL_MOD_755} $(TEMPROOT)$(MANDIR) 100 | $(INSTALL) -m ${INSTALL_MOD_644} src/files/ocsigenserver.1 $(TEMPROOT)$(MANDIR) 101 | 102 | uninstall: 103 | -make -C doc uninstall 104 | -rm -f $(TEMPROOT)$(CONFIGDIR)/ocsigenserver.conf.sample 105 | -rm -f $(TEMPROOT)$(MANDIR)/ocsigenserver.1 106 | -rm -f $(TEMPROOT)$(COMMANDPIPE) 107 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(CONFIGDIR)/conf.d 108 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(CONFIGDIR) 109 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(LOGDIR) 110 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(DATADIR) 111 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(MANDIR) 112 | 113 | purge: purge.files 114 | 115 | purge.files: 116 | -rm -f $(TEMPROOT)$(CONFIGDIR)/mime.types $(TEMPROOT)$(CONFIGDIR)/mime.types.old 117 | -rm -f $(TEMPROOT)$(CONFIGDIR)/ocsigenserver.conf 118 | -rm -f $(patsubst local/var/www/ocsigenstuff/%, \ 119 | $(TEMPROOT)$(STATICPAGESDIR)/ocsigenstuff/%, \ 120 | $(wildcard local/var/www/ocsigenstuff/*)) 121 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(STATICPAGESDIR)/ocsigenstuff 122 | -rm -f $(patsubst local/var/www/%, \ 123 | $(TEMPROOT)$(STATICPAGESDIR)/%, \ 124 | $(wildcard local/var/www/*.html)) 125 | -rmdir --ignore-fail-on-non-empty $(TEMPROOT)$(STATICPAGESDIR) 126 | 127 | install.doc: 128 | ${MAKE} -C doc install 129 | 130 | ### Install logrotate configuration files ### 131 | 132 | .PHONY: logrotate 133 | 134 | logrotate: 135 | $(INSTALL) -m 755 -d $(TEMPROOT)/etc/logrotate.d 136 | cat src/files/logrotate.in \ 137 | | sed s%LOGDIR%$(LOGDIR)%g \ 138 | | sed s%USER%$(OCSIGENUSER)%g \ 139 | | sed s%GROUP%"$(OCSIGENGROUP)"%g \ 140 | | sed s%_COMMANDPIPE_%$(COMMANDPIPE)%g \ 141 | > $(TEMPROOT)/etc/logrotate.d/ocsigenserver 142 | -------------------------------------------------------------------------------- /Makefile.dist: -------------------------------------------------------------------------------- 1 | 2 | ## 3 | ## Usage: 4 | ## 5 | ## If the released version is tagged in the main repository, use: 6 | ## 7 | ## make -f Makefile.dist 8 | ## 9 | ## If the tag has not been pushed, use: 10 | ## 11 | ## make -f Makefile.dist REPO=${PWD} 12 | ## 13 | ## otherwise, use: 14 | ## 15 | ## make -f Makefile.dist REPO=${PWD} VERSION=master 16 | ## 17 | 18 | #VERSION?=$(shell grep Version: _oasis | cut -d ' ' -f 2) 19 | VERSION=$(shell cat VERSION) 20 | REPO?=https://github.com/ocsigen/ocsigenserver 21 | 22 | all: dist sign 23 | 24 | dist: 25 | @rm -rf ocsigenserver-${VERSION} \ 26 | ocsigenserver-${VERSION}.tar.gz \ 27 | ocsigenserver-${VERSION}.tar.gz.asc 28 | git clone --local -b ${VERSION} ${REPO} ocsigenserver-${VERSION} 29 | # oasis -C ocsigenserver-${VERSION} setup 30 | # sed -i "s/SETUP := setup-dev.exe/SETUP := setup.exe/" \ 31 | # ocsigenserver-${VERSION}/Makefile 32 | cd ocsigenserver-${VERSION} && rm -rf .git .gitignore Makefile.dist 33 | tar cvzf ocsigenserver-${VERSION}.tar.gz ocsigenserver-${VERSION} 34 | @rm -rf ocsigenserver-${VERSION} 35 | 36 | sign: ocsigenserver-${VERSION}.tar.gz.asc 37 | 38 | ocsigenserver-${VERSION}.tar.gz.asc: ocsigenserver-${VERSION}.tar.gz 39 | gpg --armor -b $^ 40 | 41 | .PHONY: dist sign 42 | -------------------------------------------------------------------------------- /Makefile.options: -------------------------------------------------------------------------------- 1 | THREAD := -thread 2 | 3 | BLD=$(dir $(abspath $(lastword $(MAKEFILE_LIST))))_build/default/src 4 | 5 | INCS= -I ${BLD}/server/.ocsigenserver.objs/byte \ 6 | -I ${BLD}/http/.http.objs/byte \ 7 | -I ${BLD}/http/.ocsigen_cookie_map.objs/byte \ 8 | -I ${BLD}/baselib/.baselib.objs/byte \ 9 | -I ${BLD}/baselib/.ocsigen_lib_base.objs/byte \ 10 | -I ${BLD}/baselib/polytables/.polytables.objs/byte \ 11 | -I ${BLD}/extensions/.accesscontrol.objs/byte \ 12 | -I ${BLD}/extensions/.authbasic.objs/byte \ 13 | -I ${BLD}/extensions/.cors.objs/byte \ 14 | -I ${BLD}/extensions/.extendconfiguration.objs/byte \ 15 | -I ${BLD}/extensions/.outputfilter.objs/byte \ 16 | -I ${BLD}/extensions/.redirectmod.objs/byte \ 17 | -I ${BLD}/extensions/.revproxy.objs/byte \ 18 | -I ${BLD}/extensions/.rewritemod.objs/byte \ 19 | -I ${BLD}/extensions/.staticmod.objs/byte \ 20 | -I ${BLD}/extensions/.userconf.objs/byte \ 21 | -I ${BLD}/extensions/deflatemod/.deflatemod.objs/byte 22 | 23 | ## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable 24 | ## but also to generate src/baselib/ocsigen_config_static.ml 25 | 26 | SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,logs,logs-syslog,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix 27 | 28 | LIBS := -package ${SERVER_PACKAGE} ${INCS} 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Ocsigen server 2 | 3 | ------------------------------------------------------------------ 4 | 5 | Build instructions: 6 | =================== 7 | 8 | * run "sh configure [options]" to generate 'Makefile.config' 9 | - For the full list of options, run "sh configure --help". 10 | 11 | * verify that 'Makefile.config' suits to your needs. 12 | 13 | * run "make" to compile 14 | 15 | * [optional] run "make logrotate" as root to install logrotate 16 | configuration files in /etc/logrotate.d 17 | 18 | * [optional] run "make doc" to build the ocamldoc 19 | 20 | * run "make purge" to uninstall everything (even configuration files) 21 | 22 | ------------------------------------------------------------------ 23 | 24 | Local testings: 25 | =============== 26 | 27 | To run the automated tests, do: 28 | 29 | * dune runtest --auto-promote 30 | 31 | * this will update the files at test/extensions/*/run.t to reflect the 32 | behavior of ocsigenserver. The test files don't change if the server did not 33 | change behavior. Use Git to see the eventual changes. 34 | 35 | Alternatively, you can also test the 'ocsigenserver' program using a config file: 36 | 37 | * run "make run.local" or "make run.opt.local" 38 | in the ocsigen source directory. 39 | 40 | * open http://localhost:8080/index.html in your browser 41 | 42 | * if it does not work, look at the logs (see 'local/var/log/' in the 43 | ocsgigen source directory) or run ocsigen with options -v. 44 | 45 | * this will use the config file at 'local/etc/ocsigenserver.conf'. 46 | 47 | ------------------------------------------------------------------ 48 | 49 | Authors: 50 | ======== 51 | 52 | * Vincent Balat 53 | (project leader, Web server, Ocsigenmod, Eliom, Eliom client, Staticmod, XHTML syntax extension, documentation, Ocsimore, extension mechanism, Ocsidbm, Ocsipersist with DBM, ...) 54 | 55 | * Jérôme Vouillon 56 | (Lwt, Web server, js_of_ocaml, O'Closure, ...) 57 | 58 | * Boris Yakobowski 59 | (Ocsimore, module Extendconfiguration, Ocsigen server...) 60 | 61 | * Benjamin Canou 62 | (O'Browser) 63 | 64 | * Jérémie Dimino 65 | (Lwt) 66 | 67 | * Raphaël Proust 68 | (Ocsforge, Eliom client, Comet) 69 | 70 | * Stéphane Glondu 71 | (Configuration file, Findlib integration, access control, HTTP authentication, Debian package, ...) 72 | 73 | * Gabriel Kerneis 74 | (XHTML syntax extension for OCaml 3.10, Ocsipersist with SQLite, CGI module, forms in Eliom, deflatemod, ...) 75 | 76 | * Denis Berthod 77 | (HTTP protocol, Web server) 78 | 79 | * Grégoire Henry 80 | (safe unmarshalling of client data) 81 | 82 | * Pierre Chambart 83 | (Comet) 84 | 85 | * Jaap Boender 86 | (Ocsimore, NetBSD and Godi packages) 87 | 88 | * Gabriel Scherer 89 | (Macaque) 90 | 91 | * Gabriel Cardoso 92 | (O'Closure) 93 | 94 | * Jean-Henri Granarolo 95 | (Ocsforge) 96 | 97 | * Simon Castellan 98 | (HTML5, OpenID, SVG) 99 | 100 | * Piero Furiesi 101 | (Ocsimore) 102 | 103 | * Thorsten Ohl 104 | (most of the functions generating XHTML (xML and xHTML modules)) 105 | 106 | * Mauricio Fernandez 107 | (Xhtmlcompact, static linking of extensions and Eliom modules) 108 | 109 | * Nataliya Guts 110 | (Web server, HTTPS) 111 | 112 | * Archibald Pontier 113 | (Atom, Pubsubhubbub) 114 | 115 | * Jérôme Velleine 116 | (CGI module) 117 | 118 | * Charles Oran 119 | (O'Closure) 120 | 121 | * Pierre Clairambault 122 | (Lwt_lib, Gentoo package, configure script, ...) 123 | 124 | * Cécile Herbelin 125 | (HTML5, Benchmarks) 126 | 127 | * Jan Rochel 128 | (Ocsipersist) 129 | -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 6.0.0 2 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.config 2 | include ../Makefile.options 3 | 4 | OCAMLDOC := ${OCAMLFIND} ocamldoc 5 | ODOC_WIKI := odoc_wiki.cma 6 | 7 | DOC := baselib/ocsigen_cache.mli \ 8 | baselib/ocsigen_lib_base.mli \ 9 | baselib/ocsigen_lib.mli \ 10 | baselib/ocsigen_config_static.mli \ 11 | baselib/ocsigen_stream.mli \ 12 | baselib/ocsigen_loader.mli \ 13 | baselib/polytables/polytables.mli \ 14 | \ 15 | http/ocsigen_charset_mime.mli \ 16 | http/ocsigen_cookie_map.mli \ 17 | http/ocsigen_header.mli \ 18 | \ 19 | server/ocsigen_config.mli \ 20 | server/ocsigen_command.mli \ 21 | server/ocsigen_request.mli \ 22 | server/ocsigen_response.mli \ 23 | server/ocsigen_messages.mli \ 24 | server/ocsigen_multipart.mli \ 25 | server/ocsigen_extensions.mli \ 26 | server/ocsigen_parseconfig.mli \ 27 | server/ocsigen_local_files.mli \ 28 | server/ocsigen_server.mli 29 | 30 | PLUGINS_DOC := extensions/accesscontrol.mli \ 31 | extensions/authbasic.mli \ 32 | extensions/outputfilter.mli \ 33 | extensions/extendconfiguration.mli \ 34 | extensions/redirectmod.mli \ 35 | extensions/rewritemod.mli \ 36 | extensions/userconf.mli \ 37 | extensions/revproxy.mli \ 38 | extensions/staticmod.mli \ 39 | extensions/deflatemod.mli \ 40 | extensions/cors.mli 41 | 42 | all: doc wikidoc 43 | 44 | doc: api-html/index.html 45 | api-html/index.html: indexdoc $(addprefix ../src/,$(DOC) $(PLUGINS_DOC)) 46 | mkdir -p api-html 47 | $(OCAMLDOC) ${LIBS} -d api-html -intro indexdoc -html $(addprefix ../src/,$(DOC) $(PLUGINS_DOC)) 48 | 49 | wikidoc: api-wiki/index.wiki 50 | api-wiki/index.wiki: indexdoc $(addprefix ../src/,$(DOC) $(PLUGINS_DOC)) 51 | mkdir -p api-wiki 52 | $(OCAMLDOC) ${LIBS} -d api-wiki -intro indexdoc -colorize-code \ 53 | -i $(shell ocamlfind query wikidoc) -g ${ODOC_WIKI} \ 54 | $(addprefix ../src/,$(DOC) $(PLUGINS_DOC)) 55 | 56 | install: 57 | ${INSTALL} -d -m 755 $(TEMPROOT)$(DOCDIR) 58 | $(INSTALL) -m 644 api-html/* $(TEMPROOT)$(DOCDIR) 59 | 60 | uninstall: 61 | -rm -Rf $(TEMPROOT)$(DOCDIR) 62 | 63 | clean: 64 | -rm -f api-html/* api-wiki/* 65 | -rm -f *~ \#* .\#* 66 | -------------------------------------------------------------------------------- /doc/indexdoc: -------------------------------------------------------------------------------- 1 | {1 Ocsigen server - API reference} 2 | {!modules: 3 | Ocsigen_server 4 | } 5 | {2 Extensions} 6 | {!modules: 7 | Staticmod 8 | Extendconfiguration 9 | Accesscontrol 10 | Authbasic 11 | Deflatemod 12 | Redirectmod 13 | Revproxy 14 | Rewritemod 15 | Outputfilter 16 | Userconf 17 | Cors 18 | } 19 | 20 | {2 Persistent data, writing in the logs, configuration file extension, polymorphic tables} 21 | {!modules: 22 | Ocsigen_lib 23 | Ocsigen_messages 24 | Ocsigen_parseconfig 25 | Polytables 26 | Ocsigen_cache 27 | Ocsigen_config 28 | } 29 | 30 | {2 Extending Ocsigen Server} 31 | {!modules: 32 | Ocsigen_extensions 33 | Ocsigen_local_files 34 | Ocsigen_header 35 | Ocsigen_stream 36 | } 37 | 38 | {2 Indexes} 39 | 40 | {!indexlist} 41 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (flags 4 | (:standard -w -69)))) 5 | 6 | (rule 7 | (target ocsigenserver.conf.sample) 8 | (action 9 | (with-stdout-to 10 | %{target} 11 | (run src/files/ocsigenserver.conf/gen.exe sample)))) 12 | 13 | (install 14 | (files ocsigenserver.conf.sample) 15 | (section etc) 16 | (package ocsigenserver)) 17 | 18 | (subdir 19 | local/etc 20 | (rule 21 | (mode 22 | (promote (until-clean))) 23 | (target ocsigenserver.conf) 24 | (action 25 | (with-stdout-to 26 | %{target} 27 | (run ../../src/files/ocsigenserver.conf/gen.exe local))))) 28 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.19) 2 | (name ocsigenserver) 3 | (version 6.0.0) 4 | 5 | (generate_opam_files true) 6 | 7 | (license "LGPL-2.1-only WITH OCaml-LGPL-linking-exception") 8 | (authors "Ocsigen team ") 9 | (maintainers "Ocsigen team ") 10 | (source (github ocsigen/ocsigenserver)) 11 | (homepage "http://ocsigen.org/ocsigenserver") 12 | 13 | (package 14 | (name ocsigenserver) 15 | (synopsis "A full-featured and extensible Web server") 16 | (description 17 | "Ocsigen Server is a Web Server that can be used either as a library for OCaml or as an executable (taking its configuration from a file). It has a very powerful extension mechanism that makes it very easy to plug your own OCaml modules for generating pages. Many extensions are already implemented, like a reverse proxy, content compression, access control, authentication, etc.") 18 | (depends 19 | (ocaml (>= 4.08.1)) 20 | (camlzip (>= 1.04)) 21 | (cohttp-lwt-unix (and (>= 5.0) (< 6.0))) 22 | (conduit-lwt-unix (and (>= 2.0) (< 7.0))) 23 | cryptokit 24 | (ipaddr (>= 2.1)) 25 | (lwt (>= 3.0)) 26 | lwt_react 27 | lwt_ssl 28 | ocamlfind 29 | (re (>= 1.11)) 30 | react 31 | (ssl (>= 0.5.8)) 32 | xml-light 33 | logs 34 | logs-syslog 35 | syslog-message) 36 | (conflicts 37 | (pgocaml (< 2.2)))) 38 | -------------------------------------------------------------------------------- /local/var/www/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 |

It works !

4 | 5 | 6 | -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/AUTHORS: -------------------------------------------------------------------------------- 1 | Oxygen Icon Theme has been developed by The Oxygen Team. 2 | 3 | Art Directors: 4 | Nuno F. Pinheiro 5 | David Vignoni 6 | 7 | Naming Coordinator 8 | Jakob Petsovits 9 | 10 | Designers: 11 | David J. Miller 12 | David Vignoni 13 | Johann Ollivier Lapeyre 14 | Kenneth Wimer 15 | Nuno F. Pinheiro 16 | Riccardo Iaconelli 17 | David J. Miller 18 | 19 | Thanks to: 20 | Lee Olson: Contributed drawing used in application-x-bittorent icon. 21 | Marco Aurélio "Coré": Improved audio-input-microphone icon. 22 | Matthias Kretz: Contributed "audio-input-line" device icon. 23 | Mauricio Piacentini : game icons mashup 24 | Erlend Hamberg: "text-x-haskell" mimetype icon. 25 | -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/back.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/back.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/cdimage.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/cdimage.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/deb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/deb.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/dvi.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/dvi.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/folder_open.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/folder_open.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/html.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/html.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/image.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/image.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/ocsigen5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/ocsigen5.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/pdf.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/pdf.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/postscript.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/postscript.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/readme.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/readme.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/rpm.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/rpm.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-pdf.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-pdf.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-postscript.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-postscript.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-rtf.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-rtf.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-vnd.oasis.opendocument.presentation.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-vnd.oasis.opendocument.presentation.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-cd-image.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-cd-image.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-deb.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-deb.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-mswinurl.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-mswinurl.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-perl.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-perl.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-rpm.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-rpm.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-tar.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-tar.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/application-x-tarz.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/application-x-tarz.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/audio-ac3.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/audio-ac3.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/document-open-folder.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/document-open-folder.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/draw-arrow-back.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/draw-arrow-back.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/image-x-generic.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/image-x-generic.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/mixer-video.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/mixer-video.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/text-plain.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/text-plain.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/text-x-csrc.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/text-x-csrc.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/text-x-java.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/text-x-java.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/text-x-python.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/text-x-python.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/text-x-tex.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/text-x-tex.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/scalable/unknown.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/scalable/unknown.svgz -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/sound.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/sound.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/source_c.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/source_c.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/source_java.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/source_java.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/source_pl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/source_pl.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/source_py.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/source_py.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/style.css: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/style.css -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/tar.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/tar.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/tex.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/tex.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/tgz.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/tgz.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/txt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/txt.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/unknown.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/unknown.png -------------------------------------------------------------------------------- /local/var/www/ocsigenstuff/video.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/local/var/www/ocsigenstuff/video.png -------------------------------------------------------------------------------- /ocsigenserver.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "6.0.0" 4 | synopsis: "A full-featured and extensible Web server" 5 | description: 6 | "Ocsigen Server is a Web Server that can be used either as a library for OCaml or as an executable (taking its configuration from a file). It has a very powerful extension mechanism that makes it very easy to plug your own OCaml modules for generating pages. Many extensions are already implemented, like a reverse proxy, content compression, access control, authentication, etc." 7 | maintainer: ["Ocsigen team "] 8 | authors: ["Ocsigen team "] 9 | license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" 10 | homepage: "http://ocsigen.org/ocsigenserver" 11 | bug-reports: "https://github.com/ocsigen/ocsigenserver/issues" 12 | depends: [ 13 | "dune" {>= "3.19"} 14 | "ocaml" {>= "4.08.1"} 15 | "camlzip" {>= "1.04"} 16 | "cohttp-lwt-unix" {>= "5.0" & < "6.0"} 17 | "conduit-lwt-unix" {>= "2.0" & < "7.0"} 18 | "cryptokit" 19 | "ipaddr" {>= "2.1"} 20 | "lwt" {>= "3.0"} 21 | "lwt_react" 22 | "lwt_ssl" 23 | "ocamlfind" 24 | "re" {>= "1.11"} 25 | "react" 26 | "ssl" {>= "0.5.8"} 27 | "xml-light" 28 | "logs" 29 | "logs-syslog" 30 | "syslog-message" 31 | "odoc" {with-doc} 32 | ] 33 | conflicts: [ 34 | "pgocaml" {< "2.2"} 35 | ] 36 | dev-repo: "git+https://github.com/ocsigen/ocsigenserver.git" 37 | x-maintenance-intent: ["(latest)"] 38 | build: [ 39 | [ 40 | "sh" 41 | "configure" 42 | "--prefix" 43 | "%{prefix}%" 44 | "--ocsigen-user" 45 | "%{user}%" 46 | "--ocsigen-group" 47 | "%{group}%" 48 | "--commandpipe" 49 | "%{lib}%/ocsigenserver/var/run/ocsigenserver_command" 50 | "--logdir" 51 | "%{lib}%/ocsigenserver/var/log/ocsigenserver" 52 | "--mandir" 53 | "%{man}%/man1" 54 | "--docdir" 55 | "%{lib}%/ocsigenserver/share/doc/ocsigenserver" 56 | "--commandpipe" 57 | "%{lib}%/ocsigenserver/var/run/ocsigenserver_command" 58 | "--staticpagesdir" 59 | "%{lib}%/ocsigenserver/var/www" 60 | "--datadir" 61 | "%{lib}%/ocsigenserver/var/lib/ocsigenserver" 62 | "--temproot" 63 | "" 64 | "--sysconfdir" 65 | "%{lib}%/ocsigenserver/etc/ocsigenserver" 66 | ] 67 | ["dune" "build" "-p" name "-j" jobs] 68 | ] 69 | install:[make "install.files"] 70 | -------------------------------------------------------------------------------- /ocsigenserver.opam.template: -------------------------------------------------------------------------------- 1 | build: [ 2 | [ 3 | "sh" 4 | "configure" 5 | "--prefix" 6 | "%{prefix}%" 7 | "--ocsigen-user" 8 | "%{user}%" 9 | "--ocsigen-group" 10 | "%{group}%" 11 | "--commandpipe" 12 | "%{lib}%/ocsigenserver/var/run/ocsigenserver_command" 13 | "--logdir" 14 | "%{lib}%/ocsigenserver/var/log/ocsigenserver" 15 | "--mandir" 16 | "%{man}%/man1" 17 | "--docdir" 18 | "%{lib}%/ocsigenserver/share/doc/ocsigenserver" 19 | "--commandpipe" 20 | "%{lib}%/ocsigenserver/var/run/ocsigenserver_command" 21 | "--staticpagesdir" 22 | "%{lib}%/ocsigenserver/var/www" 23 | "--datadir" 24 | "%{lib}%/ocsigenserver/var/lib/ocsigenserver" 25 | "--temproot" 26 | "" 27 | "--sysconfdir" 28 | "%{lib}%/ocsigenserver/etc/ocsigenserver" 29 | ] 30 | ["dune" "build" "-p" name "-j" jobs] 31 | ] 32 | install:[make "install.files"] 33 | -------------------------------------------------------------------------------- /src/baselib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ocsigen_lib_base) 3 | (public_name ocsigenserver.baselib.base) 4 | (flags 5 | (:standard -no-keep-locs)) 6 | (modules ocsigen_lib_base) 7 | (libraries lwt)) 8 | 9 | (library 10 | (name baselib) 11 | (public_name ocsigenserver.baselib) 12 | (wrapped false) 13 | (flags 14 | (:standard -no-keep-locs)) 15 | (modules 16 | dynlink_wrapper 17 | ocsigen_cache 18 | ocsigen_config_static 19 | ocsigen_lib 20 | ocsigen_loader 21 | ocsigen_stream) 22 | (libraries 23 | str 24 | findlib 25 | lwt.unix 26 | cryptokit 27 | re 28 | ocsigen_lib_base 29 | logs 30 | (select 31 | dynlink_wrapper.ml 32 | from 33 | (dynlink -> dynlink_wrapper.natdynlink.ml) 34 | (_ -> dynlink_wrapper.nonatdynlink.ml)))) 35 | 36 | (rule 37 | (with-stdout-to 38 | ocsigen_config_static.ml 39 | (run ../files/ocsigenserver.conf/gen.exe static.ml))) 40 | -------------------------------------------------------------------------------- /src/baselib/dynlink_wrapper.natdynlink.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * File dynlink_wrapper.ml 4 | * Copyright (C) 2008 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | open Dynlink 22 | 23 | exception Error = Dynlink.Error 24 | 25 | let loadfile = loadfile 26 | let error_message = error_message 27 | let allow_unsafe_modules = allow_unsafe_modules 28 | let prohibit = prohibit 29 | let is_native = is_native 30 | -------------------------------------------------------------------------------- /src/baselib/dynlink_wrapper.nonatdynlink.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * File dynlink_wrapper.ml 4 | * Copyright (C) 2008 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | exception Error of string 22 | 23 | let message = "ocsigen compiled without native dynlink support" 24 | let loadfile _ = failwith message 25 | let error_message _ = failwith message 26 | let init _ = () 27 | let allow_unsafe_modules _ = () 28 | let prohibit _ = () 29 | let is_native = false 30 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_cache.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2009 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | (** 20 | Cache. 21 | Association tables (from any kind of database) 22 | that keep the most recently used values in memory. 23 | It is also possible to set a maximum lifetime for data in the cache. 24 | 25 | It is based on a structure of doubly linked lists with maximum size, 26 | that keeps only the mostly recently used values first, if you call the [up] 27 | function each time you use a value. 28 | (Insertion, remove and "up" in time 1). 29 | This structure is exported, so that it can be used in other cases. 30 | 31 | Not (preemptive) thread safe. 32 | 33 | @author Vincent Balat 34 | @author Raphaël Proust (adding timers) 35 | *) 36 | 37 | module Make : functor 38 | (A : sig 39 | type key 40 | type value 41 | end) 42 | -> sig 43 | (** [new cache finder ?timer size] creates a cache object where [finder] 44 | is the function responsible for retrieving non-cached data, [timer] 45 | (if any) is the life span of cached values (in seconds) (values in the 46 | cache are removed after their time is up) and [size] is the upper 47 | bound to the number of simultaneoulsy cached elements. 48 | 49 | Whenever a value is found (using [find] method), it's lifespan is set 50 | to [timer] (or not if the cache is not time bounded). If the value was 51 | already cached, it's lifespan is reset to [timer]. 52 | 53 | Using [timer] allow one to create a cache 54 | bounded both in space and time. It is to be noted that real lifespan 55 | of values is always slightly greater than [timer]. *) 56 | class cache : (A.key -> A.value Lwt.t) -> ?timer:float -> int -> object 57 | method find : A.key -> A.value Lwt.t 58 | (** Find the cached value associated to the key, or binds this 59 | value in the cache using the function [finder] passed as argument 60 | to [create], and returns this value *) 61 | 62 | method find_in_cache : A.key -> A.value 63 | (** Find the cached value associated to the key. Raises [Not_found] 64 | if the key is not present in the cache *) 65 | 66 | method remove : A.key -> unit 67 | method add : A.key -> A.value -> unit 68 | method clear : unit -> unit 69 | method size : int 70 | end 71 | end 72 | 73 | val clear_all_caches : unit -> unit 74 | (** Clear the contents of all the existing caches *) 75 | 76 | (** Doubly-linked lists with maximum number of entries, 77 | and (possibly) limited lifespan for entries. *) 78 | module Dlist : sig 79 | type 'a t 80 | type 'a node 81 | 82 | val create : ?timer:float -> int -> 'a t 83 | (** Create a dlist. It takes the maximum length of the list as 84 | parameter. The optional [?timer] parameter sets a maximum 85 | lifetime for elements (in seconds). *) 86 | 87 | val add : 'a -> 'a t -> 'a option 88 | (** Adds an element to the list, 89 | and possibly returns the element that has been removed if the maximum 90 | size was exceeded. *) 91 | 92 | val remove : 'a node -> unit 93 | (** Removes an element from its list. 94 | If it is not in a list, it does nothing. 95 | If it is in a list, it calls the finaliser, then removes the element. 96 | If the finaliser fails with an exception, 97 | the element is removed and the exception is raised again. 98 | *) 99 | 100 | val up : 'a node -> unit 101 | (** Removes the element from its list without finalising, 102 | then adds it as newest. *) 103 | 104 | val newest : 'a t -> 'a node option 105 | val oldest : 'a t -> 'a node option 106 | val size : 'a t -> int 107 | val maxsize : 'a t -> int 108 | val value : 'a node -> 'a 109 | 110 | val get_timer : 'a t -> float option 111 | (** returns the timer of the Dlist *) 112 | 113 | val list_of : 'a node -> 'a t option 114 | (** The list to which the node belongs *) 115 | 116 | val remove_n_oldest : 'a t -> int -> 'a list 117 | (** remove the n oldest values (or less if the list is not long enough) ; 118 | returns the list of removed values *) 119 | 120 | val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 121 | (** fold over the elements from the cache starting from the newest 122 | to the oldest *) 123 | 124 | val fold_back : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 125 | (** fold over the elements from the cache starting from the oldest 126 | to the newest *) 127 | 128 | val move : 'a node -> 'a t -> 'a option 129 | (** Move a node from one dlist to another one, without finalizing. 130 | If one value is removed from the destination list (because its 131 | maximum size is reached), it is returned (after finalisation). *) 132 | 133 | val set_maxsize : 'a t -> int -> 'a list 134 | (** change the maximum size ; 135 | returns the list of removed values, if any. 136 | *) 137 | 138 | val set_finaliser_before : ('a node -> unit) -> 'a t -> unit 139 | (** set a function to be called automatically on a piece of data 140 | just before it disappears from the list 141 | (either by explicit removal or because the maximum size is exceeded) *) 142 | 143 | val get_finaliser_before : 'a t -> 'a node -> unit 144 | val add_finaliser_before : ('a node -> unit) -> 'a t -> unit 145 | 146 | val set_finaliser_after : ('a node -> unit) -> 'a t -> unit 147 | (** set a function to be called automatically on a piece of data 148 | just after it disappears from the list 149 | (either by explicit removal or because the maximum size is exceeded) *) 150 | 151 | val get_finaliser_after : 'a t -> 'a node -> unit 152 | val add_finaliser_after : ('a node -> unit) -> 'a t -> unit 153 | end 154 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_config_static.ml.in: -------------------------------------------------------------------------------- 1 | (* Warning! ocsigen_config_static.ml is generated automatically from 2 | ocsigen_config_static.ml.in! Do not modify it manually *) 3 | (* Ocsigen 4 | * Copyright (C) 2005 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | let version_number = "_VERSION_" 22 | let config_file = ref "_CONFIGDIR_/ocsigenserver.conf" 23 | let is_native = Sys.backend_type = Sys.Native 24 | let logdir = ref (Some "_LOGDIR_") 25 | let mimefile = ref "_CONFIGDIR_/mime.types" 26 | let datadir = ref "_DATADIR_" 27 | let bindir = ref "_BINDIR_" 28 | let extdir = ref "_EXTDIR_" 29 | let command_pipe = ref "_COMMANDPIPE_" 30 | 31 | let builtin_packages = 32 | List.fold_left 33 | (fun a s -> Ocsigen_lib.String.Set.add s a) 34 | Ocsigen_lib.String.Set.empty [_DEPS_] 35 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_config_static.mli: -------------------------------------------------------------------------------- 1 | val version_number : string 2 | val config_file : string ref 3 | val is_native : bool 4 | val logdir : string option ref 5 | val mimefile : string ref 6 | val datadir : string ref 7 | val bindir : string ref 8 | val extdir : string ref 9 | val command_pipe : string ref 10 | val builtin_packages : Ocsigen_lib.String.Set.t 11 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_lib.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2005 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | (** This module contains some auxiliaries for the Ocsigenserver. In contrast to 20 | {!Ocsigen_lib_base}, the function may also refer to libraries other than the 21 | standard library. 22 | *) 23 | 24 | include 25 | module type of Ocsigen_lib_base 26 | with type poly = Ocsigen_lib_base.poly 27 | and type yesnomaybe = Ocsigen_lib_base.yesnomaybe 28 | and type ('a, 'b) leftright = ('a, 'b) Ocsigen_lib_base.leftright 29 | and type 'a Clist.t = 'a Ocsigen_lib_base.Clist.t 30 | and type 'a Clist.node = 'a Ocsigen_lib_base.Clist.node 31 | 32 | val make_cryptographic_safe_string : unit -> string 33 | (** Generate an unique and cryptographically safe random string. 34 | It is impossible to guess for other people and 35 | will never return twice the same value (with very good probabilities). *) 36 | 37 | module String : module type of String_base 38 | 39 | module Ip_address : sig 40 | exception No_such_host 41 | 42 | val get_inet_addr : ?v6:bool -> string -> Unix.inet_addr Lwt.t 43 | end 44 | 45 | module Filename : sig 46 | include module type of Filename 47 | 48 | (* val basename : string -> string *) 49 | (* val extension : string -> string *) 50 | val extension_no_directory : string -> string 51 | end 52 | 53 | module Url : sig 54 | include module type of Url_base with type t = Url_base.t 55 | 56 | val fixup_url_string : t -> t 57 | val encode : ?plus:bool -> string -> string 58 | val decode : ?plus:bool -> string -> string 59 | val make_encoded_parameters : (string * string) list -> string 60 | val string_of_url_path : encode:bool -> path -> uri 61 | 62 | val parse : 63 | t 64 | -> bool option 65 | * string option 66 | * int option 67 | * string 68 | * string list 69 | * string option 70 | * (string * string) list Lazy.t 71 | (** [parse url] returns a tuple containing information about [url] 72 | {ul 73 | {- If url contains scheme 'https'} 74 | {- host of url (ex: http://www.ocsigen.org/ -> www.ocsigen.org)} 75 | {- port of url} 76 | {- path as [string] without first '/'} 77 | {- path as [string list]} 78 | {- GET query of url} 79 | {- lazy value to decode GET query } 80 | } 81 | *) 82 | 83 | val prefix_and_path_of_t : string -> string * string list 84 | (** [prefix_and_path_of_t url] splits [url] in a couple [(prefix, path)] where 85 | [prefix] is ["http(s)://host:port"] and [path] is the path as [string list] 86 | 87 | Example: [prefix_and_path_of_t "http://ocsigen.org:80/tuto/manual"] 88 | returns [("http://ocsigen.org:80", ["tuto", "manual"])]. 89 | *) 90 | end 91 | 92 | (**/**) 93 | 94 | (* This exists to facilitate transition away from Ocamlnet. Do not use 95 | for new code! *) 96 | module Netstring_pcre : sig 97 | open Re 98 | 99 | val regexp : string -> Pcre.regexp 100 | val matched_group : Pcre.groups -> int -> string -> string 101 | val matched_string : Pcre.groups -> string -> string 102 | val global_replace : Pcre.regexp -> string -> string -> string 103 | val search_forward : Pcre.regexp -> string -> int -> int * Pcre.groups 104 | val split : Pcre.regexp -> string -> string list 105 | val string_match : Pcre.regexp -> string -> int -> Pcre.groups option 106 | end 107 | 108 | module Date : sig 109 | val to_string : float -> string 110 | (** Converts Unix GMT date to string *) 111 | end 112 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_lib_base.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2005 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | (** This module just contains only extensions of the standard library and very 20 | basic Ocsigen values and exceptions. Cf. {!Ocsigen_lib} for functionality 21 | which depends on specific external libraries. 22 | *) 23 | 24 | exception Ocsigen_Internal_Error of string 25 | exception Input_is_too_large 26 | exception Ocsigen_Bad_Request 27 | exception Ocsigen_Request_too_long 28 | 29 | include module type of Lwt.Infix 30 | 31 | val ( !! ) : 'a Lazy.t -> 'a 32 | val ( |> ) : 'a -> ('a -> 'b) -> 'b 33 | val ( @@ ) : ('a -> 'b) -> 'a -> 'b 34 | external id : 'a -> 'a = "%identity" 35 | val comp : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b 36 | val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c 37 | val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c 38 | 39 | module Tuple3 : sig 40 | val fst : 'a * 'b * 'c -> 'a 41 | val snd : 'a * 'b * 'c -> 'b 42 | val thd : 'a * 'b * 'c -> 'c 43 | end 44 | 45 | type poly 46 | 47 | val to_poly : 'a -> poly 48 | val from_poly : poly -> 'a 49 | 50 | type yesnomaybe = Yes | No | Maybe 51 | type ('a, 'b) leftright = Left of 'a | Right of 'b 52 | 53 | val advert : string 54 | 55 | (** Module Option to compute type ['a option] *) 56 | module Option : sig 57 | type 'a t = 'a option 58 | 59 | val map : ('a -> 'b) -> 'a t -> 'b t 60 | val get : (unit -> 'a) -> 'a t -> 'a 61 | val get' : 'a -> 'a t -> 'a 62 | val iter : ('a -> unit) -> 'a t -> unit 63 | val return : 'a -> 'a t 64 | val bind : 'a t -> ('a -> 'b t) -> 'b t 65 | val to_list : 'a t -> 'a list 66 | end 67 | 68 | (** Improvement of module List *) 69 | module List : sig 70 | include module type of List 71 | 72 | val map_filter : ('a -> 'b option) -> 'a list -> 'b list 73 | val last : 'a list -> 'a 74 | val assoc_remove : 'a -> ('a * 'b) list -> 'b * ('a * 'b) list 75 | val remove_first_if_any : 'a -> 'a list -> 'a list 76 | val remove_first_if_any_q : 'a -> 'a list -> 'a list 77 | val remove_first : 'a -> 'a list -> 'a list 78 | val remove_first_q : 'a -> 'a list -> 'a list 79 | val remove_all : 'a -> 'a list -> 'a list 80 | val remove_all_q : 'a -> 'a list -> 'a list 81 | val remove_all_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list 82 | val remove_all_assoc_q : 'a -> ('a * 'b) list -> ('a * 'b) list 83 | val is_prefix : 'a list -> 'a list -> bool 84 | val chop : int -> 'a list -> 'a list 85 | val split_at : int -> 'a list -> 'a list * 'a list 86 | end 87 | 88 | (** Circular lists *) 89 | module Clist : sig 90 | type 'a t 91 | type 'a node 92 | 93 | val make : 'a -> 'a node 94 | val create : unit -> 'a t 95 | val insert : 'a t -> 'a node -> unit 96 | val remove : 'a node -> unit 97 | val value : 'a node -> 'a 98 | val in_list : 'a node -> bool 99 | val is_empty : 'a t -> bool 100 | 101 | val iter : ('a -> unit) -> 'a t -> unit 102 | (** Infinite iteration on circular lists *) 103 | 104 | val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a 105 | (** Infinite fold on circular lists (use with care!) *) 106 | end 107 | 108 | module Int : sig 109 | module Table : Map.S with type key = int 110 | end 111 | 112 | (** Improvement of module String *) 113 | module String_base : sig 114 | include module type of String 115 | 116 | val remove_spaces : string -> int -> int -> string 117 | (** [remove_spaces s beg endd] returns a copy of the string from beg to endd, 118 | removing spaces at the beginning and at the end *) 119 | 120 | val basic_sep : char -> string -> string * string 121 | (** Cuts a string to the next separator *) 122 | 123 | val sep : char -> string -> string * string 124 | (** Cuts a string to the next separator, removing spaces. 125 | Raises [Not_found] if the separator cannot be found. *) 126 | 127 | val split : ?multisep:bool -> char -> string -> string list 128 | (** Splits a string for words with separator, 129 | removing spaces. 130 | For ex "azert, sdfmlskdf, dfdsfs". *) 131 | 132 | val may_append : string -> sep:string -> string -> string 133 | (* WAS add_to_string *) 134 | 135 | val may_concat : string -> sep:string -> string -> string 136 | (* WAS concat_strings *) 137 | 138 | val first_diff : string -> string -> int -> int -> int 139 | (** [first_diff s1 s2 n last] returns the index of the first difference 140 | between s1 and s2, starting from n and ending at last. 141 | returns (last + 1) if no difference is found. *) 142 | 143 | module Table : Map.S with type key = string 144 | module Set : Set.S with type elt = string 145 | module Map : Map.S with type key = string 146 | end 147 | 148 | module Url_base : sig 149 | type t = string 150 | type uri = string 151 | 152 | val make_absolute_url : https:bool -> host:string -> port:int -> uri -> t 153 | (** [make_absolute_url https host port path] generates a new absolute url *) 154 | 155 | type path = string list 156 | 157 | val remove_dotdot : path -> path 158 | (** [remove_dotdot path] cleans the path of [..] *) 159 | 160 | val remove_end_slash : string -> string 161 | (** [remove_end_slash str] removes last [/] *) 162 | 163 | val remove_internal_slash : path -> path 164 | (** [remove_internal_slash path] cleans the path of empty string *) 165 | 166 | val change_empty_list : path -> path 167 | val add_end_slash_if_missing : path -> path 168 | val remove_slash_at_end : path -> path 169 | val remove_slash_at_beginning : path -> path 170 | 171 | val is_prefix_skip_end_slash : string list -> string list -> bool 172 | (** [is_prefix_skip_end_slash path1 path2] returns [true] if [path1] is the same 173 | as [path2] before a first slash *) 174 | 175 | val split_fragment : string -> string * string option 176 | (** [split_fragment str] splits [str] at first '#' *) 177 | 178 | val join_path : path -> string 179 | 180 | (**/**) 181 | 182 | val split_path : string -> path 183 | val norm_path : path -> path 184 | end 185 | 186 | val debug : string -> unit 187 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_loader.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * File ocsigen_loader.mli 4 | * Copyright (C) 2008 Stéphane Glondu 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Module [Ocsigen_loader]: Dynamic loading for Ocsigen. *) 22 | 23 | (** Notes about Findlib usage: 24 | - Findlib is called with predicates "plugin", "mt". Moreover, the 25 | predicate "native" or "byte" is added, depending on whether 26 | Ocsigen is running in native or bytecode mode. 27 | - In native mode, .cmx/.cmxa extensions provided by META files are 28 | replaced by .cmxs. 29 | - The OCAMLPATH environment variable is ignored altogether. 30 | *) 31 | 32 | exception Dynlink_error of string * exn 33 | exception Findlib_error of string * exn 34 | 35 | val section : Logs.src 36 | 37 | val translate : string -> string 38 | (** [translate filename] translate .cmo/.cma extensions to .cmxs in 39 | native mode, and .cmxs to .cmo (.cma if it exists) in bytecode 40 | mode. *) 41 | 42 | val set_init_on_load : bool -> unit 43 | (** If set to [true], the module initialization functions passed to 44 | [set_module_init_function] will be executed directly. Otherwise, 45 | they will have to be invoked using [init_module] at some later stage. *) 46 | 47 | val loadfile : (unit -> unit) -> (unit -> unit) -> bool -> string -> unit 48 | (** [loadfile pre post force file] (dynamically) loads [file]. If 49 | [force] is [false], remember [file] so that it isn't loaded 50 | twice. If the loading effectively occurs, [pre] (resp. [post]) 51 | is called before (resp. after) the loading. [post] will be 52 | called even if the loading fails. *) 53 | 54 | val loadfiles : (unit -> unit) -> (unit -> unit) -> bool -> string list -> unit 55 | (** [loadfiles pre post force file] loads all the [files], using 56 | [loadfile (fun () -> ()) (fun () -> ()) false] for all the files 57 | but the last one, and [loadfile pre post force] for the last one 58 | (if any). *) 59 | 60 | val add_module_init_function : string -> (unit -> unit) -> unit 61 | (** [add_module_init_function name f] adds function [f] 62 | to the initialisation functions to be run 63 | when [init_module name] is called. *) 64 | 65 | val set_module_init_function : string -> (unit -> unit) -> unit 66 | (** [set_module_init_function name f] registers the function [f], which will 67 | be used to initialize the module when [init_module name] is called. 68 | Will replace the prvious value. *) 69 | 70 | val init_module : (unit -> unit) -> (unit -> unit) -> bool -> string -> unit 71 | (** [init_module pre post force name] runs the init function for the module 72 | [name]. If [force] is [false], remember [name] so that the init function 73 | isn't executed twice. If the function is executed, [pre] (resp. [post]) 74 | is called before (resp. after) the loading. [post] will be 75 | called even if the loading fails. *) 76 | 77 | val get_ocamlpath : unit -> string list 78 | (** Returns the current Findlib library search path. *) 79 | 80 | val set_ocamlpath : string list -> unit 81 | (** Sets the current Findlib library search path. The OCaml standard 82 | library path and some site-specific paths are always implicitly 83 | added. *) 84 | 85 | val add_ocamlpath : string -> unit 86 | (** Adds a path to the Findlib library search path. *) 87 | 88 | val findfiles : string -> string list 89 | (** [findfiles pkg] returns the list of files needed to load Findlib 90 | package [pkg], including dependencies. The archive files of 91 | [pkg] will appear last in the returned result. *) 92 | -------------------------------------------------------------------------------- /src/baselib/ocsigen_stream.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * ocsigen_stream.ml Copyright (C) 2005 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | exception Interrupted of exn 20 | exception Cancelled 21 | exception Already_read 22 | exception Finalized 23 | 24 | (** Streams are a means to read data block by block *) 25 | 26 | type 'a stream 27 | 28 | (** A stream may be composed by several substreams. 29 | Thus a stream is either something that contains the current buffer and 30 | a function to retrieve the following data, 31 | or a finished stream with possibly another stream following. 32 | *) 33 | type 'a step = private Finished of 'a stream option | Cont of 'a * 'a stream 34 | 35 | type 'a t 36 | type outcome = [`Success | `Failure] 37 | 38 | val make : ?finalize:(outcome -> unit Lwt.t) -> (unit -> 'a step Lwt.t) -> 'a t 39 | (** creates a new stream *) 40 | 41 | val get : 'a t -> 'a stream 42 | (** call this function if you decide to start reading a stream. 43 | @raise Already_read if the stream has already been read. *) 44 | 45 | val next : 'a stream -> 'a step Lwt.t 46 | (** get the next step of a stream. 47 | Fails with [Interrupted e] if reading the thread failed with exception [e], 48 | and with [Cancelled] if the thread has been cancelled. *) 49 | 50 | val empty : (unit -> 'a step Lwt.t) option -> 'a step Lwt.t 51 | (** creates an empty step. The parameter is the following substream, if any. *) 52 | 53 | val cont : 'a -> (unit -> 'a step Lwt.t) -> 'a step Lwt.t 54 | (** creates a non empty step. *) 55 | 56 | val add_finalizer : 'a t -> (outcome -> unit Lwt.t) -> unit 57 | (** Add a finalizer function. In the current version, 58 | finalizers must be called manually. *) 59 | 60 | val finalize : 'a t -> outcome -> unit Lwt.t 61 | (** Finalize the stream. This function must be called explicitly after reading 62 | the stream, otherwise finalizers won't be called. *) 63 | 64 | val cancel : 'a t -> unit Lwt.t 65 | (** Cancel the stream, i.e. read the stream until the end, without decoding. 66 | Further tries to read on the stream will fail with exception 67 | {!Ocsigen_stream.Cancelled} 68 | *) 69 | 70 | val consume : 'a t -> unit Lwt.t 71 | (** Consume without cancelling. 72 | Read the stream until the end, without decoding. *) 73 | 74 | exception Stream_too_small 75 | (** possibly with the size of the stream *) 76 | 77 | exception Stream_error of string 78 | exception String_too_large 79 | 80 | val string_of_stream : int -> string stream -> string Lwt.t 81 | (** Creates a string from a stream. The first argument is the upper limit of the 82 | string length *) 83 | 84 | val enlarge_stream : string step -> string step Lwt.t 85 | (** Read more data in the buffer *) 86 | 87 | val stream_want : string step -> int -> string step Lwt.t 88 | (** [stream_want s len] Returns a stream with at least len 89 | bytes in the buffer if possible *) 90 | 91 | val current_buffer : string step -> string 92 | (** Returns the value of the current buffer *) 93 | 94 | val skip : string step -> int64 -> string step Lwt.t 95 | (** Skips data. Raises [Stream_too_small (Some size)] 96 | if the stream is too small, where [size] is the size of the stream. *) 97 | 98 | val substream : string -> string step -> string step Lwt.t 99 | (** Cut the stream at the position given by a string delimiter *) 100 | 101 | val of_file : string -> string t 102 | (** returns a stream reading from a file. 103 | Do not forget to finalize the stream to close the file. 104 | *) 105 | 106 | val of_string : string -> string t 107 | (** returns a stream containing a string. *) 108 | 109 | val of_lwt_stream : 'a Lwt_stream.t -> 'a t 110 | (** Convert a {!Lwt_stream.t} to an {!Ocsigen_stream.t}. *) 111 | 112 | val to_lwt_stream : ?is_empty:('a -> bool) -> 'a t -> 'a Lwt_stream.t 113 | (** Convert an {!Ocsigen_stream.t} into a {!Lwt_stream.t}. 114 | @param is_empty function to skip empty chunk. 115 | *) 116 | 117 | module StringStream : sig 118 | type out = string t 119 | (** Interface for stream creation (for tyxml) *) 120 | 121 | type m 122 | 123 | val make : m -> out 124 | 125 | val empty : m 126 | (** Create an empty stream *) 127 | 128 | val put : string -> m 129 | (** Create a stream with one element *) 130 | 131 | val concat : m -> m -> m 132 | (** Concatenate two stream *) 133 | end 134 | 135 | (**/**) 136 | 137 | (* Small hack that will allow us to move [Ocsigen_config] out of 138 | baselib. Not super-pretty. *) 139 | val set_net_buffer_size : int -> unit 140 | -------------------------------------------------------------------------------- /src/baselib/polytables/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: default 2 | default: build 3 | 4 | .PHONY: build 5 | build: 6 | dune build 7 | 8 | ## Clean up 9 | 10 | clean: 11 | dune clean 12 | 13 | distclean: clean 14 | -rm -f *~ \#* .\#* 15 | -------------------------------------------------------------------------------- /src/baselib/polytables/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name polytables) 3 | (public_name ocsigenserver.polytables)) 4 | -------------------------------------------------------------------------------- /src/baselib/polytables/polytables.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2009 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | (** 19 | @author Vincent Balat 20 | @author Jérôme Vouillon 21 | *) 22 | 23 | type 'a key = int * 'a option ref 24 | 25 | module T = Map.Make (struct 26 | type t = int 27 | 28 | let compare = compare 29 | end) 30 | 31 | type t = (unit -> unit) T.t ref 32 | 33 | let create () = ref T.empty 34 | let c = ref (-1) 35 | 36 | let make_key () = 37 | c := !c + 1; 38 | !c, ref None 39 | 40 | let set ~(table : t) ~key:((k, r) : 'a key) ~(value : 'a) = 41 | table := T.add k (fun () -> r := Some value) !table 42 | 43 | let get ~(table : t) ~key:((k, r) : 'a key) = 44 | (T.find k !table) (); 45 | match !r with 46 | | Some v -> 47 | r := None; 48 | v 49 | | None -> failwith "Polytables.get" 50 | 51 | let remove ~(table : t) ~key:((k, _r) : 'a key) = table := T.remove k !table 52 | let clear ~(table : t) = table := T.empty 53 | -------------------------------------------------------------------------------- /src/baselib/polytables/polytables.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2009 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | (** 19 | Polymorphic tables (using Map) 20 | @author Vincent Balat 21 | @author Jérôme Vouillon 22 | *) 23 | 24 | (** Warning: this module is not thread safe! *) 25 | 26 | type 'a key 27 | (** The type of key for a piece of data of type 'a *) 28 | 29 | type t 30 | (** The type of tables *) 31 | 32 | val create : unit -> t 33 | (** creates a new table *) 34 | 35 | val make_key : unit -> 'a key 36 | (** create a new key for each data you want to save *) 37 | 38 | val set : table:t -> key:'a key -> value:'a -> unit 39 | (** [set t k v] associates [v] to [k] in [t] *) 40 | 41 | val get : table:t -> key:'a key -> 'a 42 | (** [get t k] returns the current binding of [k] in [t] or raises [Not_found] *) 43 | 44 | val remove : table:t -> key:'a key -> unit 45 | (** [remove t k] remove the current binding of [k] in [t] if it exists *) 46 | 47 | val clear : table:t -> unit 48 | (** [clear t] remove all data from t *) 49 | -------------------------------------------------------------------------------- /src/baselib/tests/test_wrapping.ml: -------------------------------------------------------------------------------- 1 | (* ocamlfind ocamlopt -linkpkg -package react -g -I ../ ../wrapping.cmxa test_wrapping.ml -o test_wrapping *) 2 | let () = Printexc.record_backtrace true 3 | 4 | (*** simple wrap test ***) 5 | 6 | type a = {a : float; a_wrap : a Ocsigen_wrap.wrapper} 7 | 8 | let a_wrap () = 9 | Ocsigen_wrap.create_wrapper (fun t -> 10 | {a = t.a +. 1.; a_wrap = Ocsigen_wrap.empty_wrapper}) 11 | 12 | let a i = {a = i; a_wrap = a_wrap ()} 13 | let va = a 3.14 14 | let _, v = Ocsigen_wrap.wrap va 15 | let () = assert (v.a -. 4.14 < 0.0001) 16 | 17 | (*** deep wrap test ***) 18 | 19 | let va = [[[[[[1, [3.1, a 3.14]], a 35.1]]]]] 20 | let _, _ = Ocsigen_wrap.wrap va 21 | 22 | (*** multiple wrap test ***) 23 | 24 | type b = {b : string; ba : a; b' : string; b_wrap : b Ocsigen_wrap.wrapper} 25 | 26 | let b_wrap () = Ocsigen_wrap.create_wrapper (fun t -> t.b, t.ba) 27 | let b s f = {b = s; b' = s; b_wrap = b_wrap (); ba = a f} 28 | let tst_string = "test" 29 | let vb = b tst_string 3.14 30 | let _, vb' = Ocsigen_wrap.wrap vb 31 | 32 | let _ = 33 | assert ( 34 | let t, f = Obj.magic vb' in 35 | t == tst_string && f -. 4.14 < 0.0001) 36 | 37 | let _, vb'' = Ocsigen_wrap.wrap [2, [1., [vb, 4, ref 0], ref 42]] 38 | 39 | let () = 40 | match vb'' with 41 | | [(2, [(1., [(vb', 4, {contents = 0})], {contents = 42})])] -> 42 | assert ( 43 | let t, f = Obj.magic vb' in 44 | t == tst_string && f -. 4.14 < 0.0001) 45 | | _ -> assert false 46 | 47 | (*** create wrap during wrap test ***) 48 | 49 | let b'_wrap () = Ocsigen_wrap.create_wrapper (fun t -> t.b, a 1.2) 50 | let b' s f = {b = s; b' = s; b_wrap = b'_wrap (); ba = a f} 51 | let vb' = b' "test" 3.14 52 | let _, vb'' = Ocsigen_wrap.wrap vb' 53 | 54 | let () = 55 | match Obj.magic vb'' with 56 | | x, y -> 57 | assert (x == vb'.b); 58 | assert (y.a -. 4.14 < 0.0001) 59 | 60 | (*** big value copy ***) 61 | 62 | let ( -- ) x y = 63 | let rec aux y x acc = if x > y then acc else aux (y - 1) x (y :: acc) in 64 | aux y x [] 65 | 66 | (* 67 | type l = 68 | | A 69 | | L of l * int 70 | 71 | let ( -- ) x y = 72 | let rec aux y x acc = 73 | if x > y then acc else aux (y-1) x (L (acc,y)) 74 | in 75 | aux y x A 76 | 77 | let _ = Marshal.to_string (0--50000000) 78 | *) 79 | let v = 0 -- 80000 80 | 81 | (* it cannot grow much bigger than that, On systems with a small 82 | stack, it could die with stack overflow *) 83 | let _, v' = Ocsigen_wrap.wrap v 84 | let () = assert (v' = v) 85 | 86 | (*** simple wrap weak test ***) 87 | 88 | let d = Weak.create 1 89 | let d_val = Some (ref 0) 90 | let _ = Weak.set d 0 d_val 91 | 92 | type d = {da : int; dw : int Weak.t; dm : d Ocsigen_wrap.wrapper} 93 | 94 | let d_wrap () = Ocsigen_wrap.create_wrapper (fun {da; dw} -> Weak.get dw 0, da) 95 | let _, d' = Ocsigen_wrap.wrap (1, d, d_wrap ()) 96 | let () = assert (Obj.magic d' = (d_val, 1)) 97 | 98 | (*** simple wrap react test ***) 99 | 100 | let r', push = React.E.create () 101 | let r = React.E.map (fun i -> i + 1) r' 102 | let c a r w = a, r, w 103 | let c_wrap () = Ocsigen_wrap.create_wrapper (fun (a, r, w) -> a) 104 | let _, c' = Ocsigen_wrap.wrap (c 1 r (c_wrap ())) 105 | let () = assert (Obj.magic c' = 1) 106 | 107 | (*** Eliom_react like test ***) 108 | 109 | let r', push = React.E.create () 110 | let r = React.E.map (fun i -> i + 1) r' 111 | 112 | type toto = {a : float; mtoto : toto Ocsigen_wrap.wrapper} 113 | type t = {v1 : int; v2 : toto; v3 : int React.event; mt : t Ocsigen_wrap.wrapper} 114 | 115 | let i = ref 0 116 | 117 | let mtoto () = 118 | Ocsigen_wrap.create_wrapper (fun t -> 119 | incr i; 120 | string_of_float t.a, !i) 121 | 122 | let mt () = Ocsigen_wrap.create_wrapper (fun t -> incr i; t.v2) 123 | let toto i = {a = i; mtoto = mtoto ()} 124 | let t i b = {v1 = i; v2 = b; v3 = r; mt = mt ()} 125 | let vtoto = toto 3.14 126 | let vt = t 42 vtoto 127 | let _, v' = Ocsigen_wrap.wrap vtoto 128 | let _, v' = Ocsigen_wrap.wrap vt 129 | 130 | (*** closure copy test ***) 131 | 132 | type t1 = {t1a : float; t1mark : t1 Ocsigen_wrap.wrapper} 133 | 134 | type t2 = 135 | {t2t1 : t1; t2f : (int ref -> unit) option; t2mark : t2 Ocsigen_wrap.wrapper} 136 | 137 | let r1 = ref 13 138 | let r2 = ref 42 139 | let r3 = ref 88 140 | 141 | let t1mark () = 142 | Ocsigen_wrap.create_wrapper (fun t -> 143 | incr r1; 144 | {t1a = 3.14; t1mark = Ocsigen_wrap.empty_wrapper}) 145 | 146 | let t2mark () = 147 | Ocsigen_wrap.create_wrapper (fun t -> 148 | (match t.t2f with Some f -> f r2 | None -> assert false); 149 | {t with t2f = None; t2mark = Ocsigen_wrap.empty_wrapper}) 150 | 151 | let t1 = {t1a = 1.1; t1mark = t1mark ()} 152 | let t2 = {t2t1 = t1; t2f = Some (fun r -> incr r; incr r3); t2mark = t2mark ()} 153 | let _, t2' = Ocsigen_wrap.wrap (Obj.repr t2) 154 | let _, t1' = Ocsigen_wrap.wrap (Obj.repr t1) 155 | 156 | let _ = 157 | assert (!r1 = 15); 158 | assert (!r2 = 43); 159 | assert (!r3 = 89) 160 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name ocsigenserver) 3 | (public_name ocsigenserver.opt) 4 | (link_flags 5 | (:standard -linkall)) 6 | (libraries dynlink ocsigenserver) 7 | (modes exe byte)) 8 | 9 | (install 10 | (files 11 | (ocsigenserver.bc as ocsigenserver)) 12 | (section bin) 13 | (package ocsigenserver)) 14 | -------------------------------------------------------------------------------- /src/extensions/accesscontrol.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module accesscontrol.ml 4 | * Copyright (C) 2007 Vincent Balat, Stéphane Glondu 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Accesscontrol: Conditional access to some sites *) 22 | 23 | (** If you want to use this extension with Ocsigen Server's configuration file, 24 | + have a look at the {% <>%}. 25 | + If you are using Ocsigen Server as a library, use the interface described 26 | + here. Each of these functions behaves exactly as its configuration file 27 | counterpart. 28 | +*) 29 | 30 | (** 31 | This module belongs to ocamlfind package 32 | [ocsigenserver.ext.accesscontrol]. 33 | *) 34 | 35 | (** Example of use (with {% <>%}): 36 | {[ 37 | let _ = 38 | Ocsigen_server.start 39 | [ Ocsigen_server.host ~regexp:".*" 40 | [ Accesscontrol.( 41 | if_ (not_ ssl) 42 | [ Redirectmod.run 43 | ~redirection: 44 | (Redirectmod.create_redirection ~full_url:false 45 | ~regexp:"(.* )" "https://yourdomain.org/\\1") 46 | () ] 47 | [ ... ]) ] 48 | ] 49 | ]} 50 | *) 51 | 52 | type condition 53 | 54 | val ip : string -> condition 55 | val port : int -> condition 56 | val ssl : condition 57 | val header : name:string -> regexp:string -> condition 58 | val method_ : Cohttp.Code.meth -> condition 59 | val protocol : Cohttp.Code.version -> condition 60 | val path : regexp:string -> condition 61 | val and_ : condition list -> condition 62 | val or_ : condition list -> condition 63 | val not_ : condition -> condition 64 | 65 | val if_ : 66 | condition 67 | -> Ocsigen_server.instruction list 68 | -> Ocsigen_server.instruction list 69 | -> Ocsigen_server.instruction 70 | 71 | val iffound : Ocsigen_server.instruction list -> Ocsigen_server.instruction 72 | 73 | val ifnotfound : 74 | ?code:string 75 | -> Ocsigen_server.instruction list 76 | -> Ocsigen_server.instruction 77 | 78 | val notfound : Ocsigen_server.instruction 79 | val nextsite : Ocsigen_server.instruction 80 | val nexthost : Ocsigen_server.instruction 81 | val stop : Ocsigen_server.instruction 82 | val forbidden : Ocsigen_server.instruction 83 | 84 | val allow_forward_for : 85 | ?check_equal_ip:bool 86 | -> unit 87 | -> Ocsigen_server.instruction 88 | 89 | val allow_forward_proto : unit -> Ocsigen_server.instruction 90 | val section : Logs.src 91 | -------------------------------------------------------------------------------- /src/extensions/authbasic.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module authbasic.ml 4 | * Copyright (C) 2008 Stéphane Glondu 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | open Lwt.Infix 22 | 23 | let section = Logs.Src.create "ocsigen:ext:access-control" 24 | 25 | type auth = string -> string -> bool Lwt.t 26 | 27 | exception Bad_config_tag_for_auth of string 28 | 29 | let register_basic_authentication_method, get_basic_authentication_method = 30 | let fun_auth = 31 | ref (fun _config -> 32 | raise (Bad_config_tag_for_auth "")) 33 | in 34 | (* register_basic_authentication_method *) 35 | ( (fun new_fun_auth -> 36 | let old_fun_auth = !fun_auth in 37 | fun_auth := 38 | fun config -> 39 | try old_fun_auth config 40 | with Bad_config_tag_for_auth _c -> new_fun_auth config) 41 | , (* get_basic_authentication_method *) 42 | fun config -> !fun_auth config ) 43 | 44 | (* Basic authentication with a predefined login/password (example) *) 45 | let () = 46 | let open Xml in 47 | register_basic_authentication_method @@ function 48 | | Element ("plain", [("login", login); ("password", password)], _) -> 49 | fun l p -> Lwt.return (login = l && password = p) 50 | | _ -> 51 | raise (Ocsigen_extensions.Bad_config_tag_for_extension "not for htpasswd") 52 | 53 | let gen ~realm ~auth rs = 54 | let reject () = 55 | let h = 56 | Cohttp.Header.init_with "WWW-Authenticate" 57 | (Printf.sprintf "Basic realm=\"%s\"" realm) 58 | in 59 | Logs.info ~src:section (fun fmt -> fmt "AUTH: invalid credentials!"); 60 | Lwt.fail (Ocsigen_cohttp.Ext_http_error (`Unauthorized, None, Some h)) 61 | and invalid_header () = 62 | Logs.info ~src:section (fun fmt -> fmt "AUTH: invalid Authorization header"); 63 | Lwt.fail 64 | (Ocsigen_cohttp.Ocsigen_http_error (Ocsigen_cookie_map.empty, `Bad_request)) 65 | in 66 | let validate ~err s = 67 | match Cohttp.Auth.credential_of_string s with 68 | | `Basic (user, pass) -> 69 | auth user pass >>= fun b -> 70 | if b then Lwt.return (Ocsigen_extensions.Ext_next err) else reject () 71 | | `Other _s -> invalid_header () 72 | in 73 | match rs with 74 | | Ocsigen_extensions.Req_not_found (err, ri) -> ( 75 | match 76 | Ocsigen_request.header ri.Ocsigen_extensions.request_info 77 | Ocsigen_header.Name.authorization 78 | with 79 | | Some s -> validate ~err s 80 | | None -> reject ()) 81 | | Ocsigen_extensions.Req_found _ -> 82 | Lwt.return Ocsigen_extensions.Ext_do_nothing 83 | 84 | let parse_config element = 85 | let realm_ref = ref "" in 86 | let rest_ref = ref [] in 87 | Ocsigen_extensions.( 88 | Configuration.process_element ~in_tag:"host" 89 | ~other_elements:(fun t _ _ -> raise (Bad_config_tag_for_extension t)) 90 | ~elements: 91 | [ Configuration.element ~name:"authbasic" 92 | ~attributes: 93 | [ Configuration.attribute ~name:"realm" ~obligatory:true (fun s -> 94 | realm_ref := s) ] 95 | ~other_elements:(fun name attrs content -> 96 | rest_ref := Xml.Element (name, attrs, content) :: !rest_ref) 97 | () ] 98 | element); 99 | let realm = !realm_ref in 100 | let auth = 101 | match !rest_ref with 102 | | [x] -> get_basic_authentication_method x 103 | | _ -> Ocsigen_extensions.badconfig "Bad syntax for tag authbasic" 104 | in 105 | gen ~realm ~auth 106 | 107 | (** Registration of the extension for the config file: *) 108 | let () = 109 | Ocsigen_extensions.register ~name:"authbasic" 110 | ~fun_site:(fun _ _ _ _ _ _ -> parse_config) 111 | () 112 | 113 | (** Instruction for static linking without config file: *) 114 | let run ~realm ~auth () _ _ _ = gen ~realm ~auth 115 | -------------------------------------------------------------------------------- /src/extensions/authbasic.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module authbasic.mli 4 | * Copyright (C) 2008 Stéphane Glondu 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Authbasic: Basic HTTP authentication *) 22 | 23 | (** If you want to use this extension with Ocsigen Server's configuration file, 24 | have a look at the {% <>%}. 25 | If you are using Ocsigen Server as a library, use the interface described 26 | here. Each of these functions behaves exactly as its configuration file 27 | counterpart. 28 | *) 29 | 30 | (** 31 | This module belongs to ocamlfind package 32 | [ocsigenserver.ext.authbasic]. 33 | *) 34 | 35 | (** Example of use: 36 | {[ 37 | let _ = 38 | Ocsigen_server.start 39 | [ Ocsigen_server.host ~regexp:".*" 40 | [ Authbasic.run ~realm:"test" 41 | ~auth:(fun u p -> Lwt.return (u = "theuser" && p = "thepassword")) 42 | () 43 | ; Staticmod.run ~dir:"static" () ]] 44 | ]} 45 | *) 46 | 47 | (** This module implements Basic HTTP Authentication as described in 48 | {{:http://www.ietf.org/rfc/rfc2617.txt}RFC 2617}. It can be used 49 | to add an authentication layer to sites with no built-in 50 | authentication (e.g. static files). Beware, passwords are 51 | transmitted in cleartext with this scheme, so the medium should be 52 | secured somehow (by e.g. SSL). 53 | 54 | This module implements only the HTTP-related part of the protocol, 55 | and is meant to be extended with various authentication schemes. A 56 | very naive one (authentication with a single user/password, given 57 | in the configuration file) is provided. *) 58 | 59 | val section : Logs.src 60 | 61 | type auth = string -> string -> bool Lwt.t 62 | 63 | val register_basic_authentication_method : (Xml.xml -> auth) -> unit 64 | (** This function registers an authentication plugin: it adds a new 65 | parser to the list of available authentication schemes. 66 | 67 | This is only applied if you are running the server with an XML 68 | configuration file. Use the realm, auth variables otherwise. 69 | 70 | A parser takes as argument an XML tree (corresponding to the 71 | first son of an element in the configuration 72 | file) and returns an authentication function [f]. [f] will be 73 | called for each request with the supplied user and password and 74 | should return (cooperatively) a boolean telling whether access 75 | is granted or not. Exceptions are handled the same way as for 76 | extension parsers. 77 | 78 | The element must have a {i realm} attribute, 79 | giving some identifier to the resource which is protected 80 | (several resources on the same hostname can share the same 81 | realm). This gives a general customization scheme "for free" 82 | from the point of view of plugin developers and is totally 83 | transparent to the plugin. *) 84 | 85 | val run : realm:string -> auth:auth -> unit -> Ocsigen_server.instruction 86 | (** [run ~realm ~auth ()] makes it possible to use this extension without 87 | configuration file. *) 88 | 89 | (**/**) 90 | 91 | val get_basic_authentication_method : Xml.xml -> auth 92 | (** This function combines all the parsers registered with 93 | [register_basic_authentication_method]. It might be useful for 94 | other extensions. Not for the casual user. *) 95 | -------------------------------------------------------------------------------- /src/extensions/cors.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module accesscontrol.ml 4 | * Copyright (C) 2011 Pierre Chambart 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Handle Cross-Origin Resource Sharing (CORS) headers *) 22 | 23 | let section = Logs.Src.create "ocsigen:ext:cors" 24 | 25 | (*** MAIN FUNCTION ***) 26 | 27 | let default_frame () = 28 | Ocsigen_response.make (Cohttp.Response.make ~status:`OK ()) 29 | 30 | type config = 31 | { methods : Cohttp.Code.meth list option 32 | ; (* None means: all method are accepted *) 33 | credentials : bool 34 | ; max_age : int option 35 | ; exposed_headers : string list } 36 | 37 | exception Refused 38 | 39 | let add_headers config r response = 40 | match Ocsigen_request.header r Ocsigen_header.Name.origin with 41 | | None -> Lwt.return Ocsigen_extensions.Ext_do_nothing 42 | | Some origin -> 43 | Logs.info ~src:section (fun fmt -> fmt "request with origin: %s" origin); 44 | let l = [Ocsigen_header.Name.access_control_allow_origin, origin] in 45 | let l = 46 | if config.credentials 47 | then (Ocsigen_header.Name.access_control_allow_credentials, "true") :: l 48 | else l 49 | in 50 | let l = 51 | match 52 | Ocsigen_request.header r 53 | Ocsigen_header.Name.access_control_request_method 54 | with 55 | | Some request_method -> 56 | let methods = 57 | match config.methods with 58 | | None -> true 59 | | Some l -> ( 60 | try List.mem (Cohttp.Code.method_of_string request_method) l 61 | with _ -> false) 62 | in 63 | if methods 64 | then 65 | (Ocsigen_header.Name.access_control_allow_methods, request_method) 66 | :: l 67 | else ( 68 | Logs.info ~src:section (fun fmt -> fmt "Method refused"); 69 | raise Refused) 70 | | None -> l 71 | in 72 | let l = 73 | match 74 | Ocsigen_request.header r 75 | Ocsigen_header.Name.access_control_request_headers 76 | with 77 | | Some request_headers -> 78 | (Ocsigen_header.Name.access_control_allow_headers, request_headers) 79 | :: l 80 | | None -> l 81 | in 82 | let l = 83 | match config.max_age with 84 | | Some max_age -> 85 | (Ocsigen_header.Name.access_control_max_age, string_of_int max_age) 86 | :: l 87 | | None -> l 88 | in 89 | let l = 90 | match config.exposed_headers with 91 | | [] -> l 92 | | exposed_headers -> 93 | ( Ocsigen_header.Name.access_control_expose_headers 94 | , String.concat ", " exposed_headers ) 95 | :: l 96 | in 97 | Lwt.return 98 | (Ocsigen_extensions.Ext_found 99 | (fun () -> Lwt.return @@ Ocsigen_response.replace_headers response l)) 100 | 101 | let main config = function 102 | | Ocsigen_extensions.Req_not_found (_, {Ocsigen_extensions.request_info; _}) 103 | -> ( 104 | match Ocsigen_request.meth request_info with 105 | | `OPTIONS -> ( 106 | Logs.info ~src:section (fun fmt -> fmt "OPTIONS request"); 107 | try add_headers config request_info (default_frame ()) 108 | with Refused -> 109 | Logs.info ~src:section (fun fmt -> fmt "Refused request"); 110 | Lwt.return Ocsigen_extensions.Ext_do_nothing) 111 | | _ -> Lwt.return Ocsigen_extensions.Ext_do_nothing) 112 | | Ocsigen_extensions.Req_found ({Ocsigen_extensions.request_info; _}, response) 113 | -> 114 | Logs.info ~src:section (fun fmt -> fmt "answered request"); 115 | add_headers config request_info response 116 | 117 | (* Register extension *) 118 | 119 | let comma_space_regexp = 120 | Ocsigen_lib.Netstring_pcre.regexp "[[:blank:]\n]*,[[:blank:]\n]*" 121 | 122 | let parse_config _ _ _parse_fun config_elem = 123 | let config = 124 | ref 125 | {methods = None; credentials = false; max_age = None; exposed_headers = []} 126 | in 127 | Ocsigen_extensions.( 128 | Configuration.process_element ~in_tag:"host" 129 | ~other_elements:(fun t _ _ -> raise (Bad_config_tag_for_extension t)) 130 | ~elements: 131 | [ Configuration.element ~name:"cors" 132 | ~attributes: 133 | [ Configuration.attribute ~name:"credentials" (fun s -> 134 | let s = bool_of_string s in 135 | config := {!config with credentials = s}) 136 | ; Configuration.attribute ~name:"max_age" (fun s -> 137 | let s = Some (int_of_string s) in 138 | config := {!config with max_age = s}) 139 | ; Configuration.attribute ~name:"exposed_headers" (fun s -> 140 | let s = 141 | Ocsigen_lib.Netstring_pcre.split comma_space_regexp s 142 | in 143 | config := {!config with exposed_headers = s}) 144 | ; Configuration.attribute ~name:"methods" (fun s -> 145 | let s = 146 | Ocsigen_lib.Netstring_pcre.split comma_space_regexp s 147 | in 148 | let s = Some (List.map Cohttp.Code.method_of_string s) in 149 | config := {!config with methods = s}) ] 150 | () ] 151 | config_elem); 152 | main !config 153 | 154 | let () = 155 | Ocsigen_extensions.register ~name:"CORS" 156 | ~fun_site:(fun _ _ _ -> parse_config) 157 | () 158 | 159 | let run ?credentials ?max_age ?exposed_headers ?methods () _ _ _ = 160 | let credentials = Ocsigen_lib.Option.get' false credentials in 161 | let exposed_headers = Ocsigen_lib.Option.get' [] exposed_headers in 162 | main {credentials; methods; max_age; exposed_headers} 163 | -------------------------------------------------------------------------------- /src/extensions/cors.mli: -------------------------------------------------------------------------------- 1 | (** Cross-Origin Resource Sharing *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | *) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.cors]. 13 | *) 14 | 15 | (** Example of use: 16 | {[ 17 | let _ = 18 | Ocsigen_server.start 19 | [ Ocsigen_server.host ~regexp:".*" 20 | [ Staticmod.run ~dir:"static" () 21 | ; Eliom.run () 22 | ; Cors.run 23 | ~max_age:86400 24 | ~credentials:true 25 | ~methods:[ `POST; `GET; `HEAD ] 26 | ~exposed_headers:[ "x-eliom-application" 27 | ; "x-eliom-location" 28 | ; "x-eliom-set-process-cookies" 29 | ; "x-eliom-set-cookie-substitutes" ] 30 | () 31 | ]] 32 | ]} 33 | *) 34 | 35 | val run : 36 | ?credentials:bool 37 | -> ?max_age:int 38 | -> ?exposed_headers:string list 39 | -> ?methods:Cohttp.Code.meth list 40 | -> unit 41 | -> Ocsigen_server.instruction 42 | (** [run] makes it possible to use this extension without 43 | configuration file. *) 44 | -------------------------------------------------------------------------------- /src/extensions/deflatemod.mli: -------------------------------------------------------------------------------- 1 | (** Deflatemod: compress output data *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | + have a look at the {% <>%}. 5 | + If you are using Ocsigen Server as a library, use the interface described 6 | + here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | +*) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.deflatemod]. 13 | *) 14 | 15 | (** Example of use: 16 | {[ 17 | let _ = 18 | Ocsigen_server.start 19 | [ Ocsigen_server.host ~regexp:".*" 20 | [ Staticmod.run ~dir:"static" () 21 | ; Deflatemod.run 22 | ~mode:(`Only [ `Type (Some "text", Some "html") 23 | ; `Type (Some "text", Some "javascript") 24 | ; `Type (Some "text", Some "css") 25 | ; `Type (Some "application", Some "javascript") 26 | ; `Type (Some "application", Some "x-javascript") 27 | ; `Type (Some "application", Some "xhtml+xml") 28 | ; `Type (Some "image", Some "svg+xml") 29 | ; `Type (Some "application", Some "x-eliom")]) () 30 | ]] 31 | ]} 32 | *) 33 | 34 | val set_compress_level : int -> unit 35 | val set_buffer_size : int -> unit 36 | 37 | type filter = [`Type of string option * string option | `Extension of string] 38 | (** Describes the content to deflate, either using its content type, 39 | or file extension *) 40 | 41 | val run : 42 | mode:[`All_but of filter list | `Only of filter list] 43 | -> unit 44 | -> Ocsigen_server.instruction 45 | (** [run ~mode ()] makes it possible to use this extension without 46 | configuration file. *) 47 | 48 | val section : Logs.src 49 | -------------------------------------------------------------------------------- /src/extensions/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name accesscontrol) 3 | (public_name ocsigenserver.ext.accesscontrol) 4 | (modules accesscontrol) 5 | (libraries ocsigenserver)) 6 | 7 | (library 8 | (name authbasic) 9 | (public_name ocsigenserver.ext.authbasic) 10 | (modules authbasic) 11 | (libraries ocsigenserver)) 12 | 13 | (library 14 | (name cors) 15 | (public_name ocsigenserver.ext.cors) 16 | (modules cors) 17 | (libraries ocsigenserver)) 18 | 19 | (library 20 | (name deflatemod) 21 | (public_name ocsigenserver.ext.deflatemod) 22 | (modules deflatemod) 23 | (libraries camlzip ocsigenserver)) 24 | 25 | (library 26 | (name extendconfiguration) 27 | (public_name ocsigenserver.ext.extendconfiguration) 28 | (modules extendconfiguration) 29 | (libraries ocsigenserver)) 30 | 31 | (library 32 | (name outputfilter) 33 | (public_name ocsigenserver.ext.outputfilter) 34 | (modules outputfilter) 35 | (libraries ocsigenserver)) 36 | 37 | (library 38 | (name redirectmod) 39 | (public_name ocsigenserver.ext.redirectmod) 40 | (modules redirectmod) 41 | (libraries ocsigenserver)) 42 | 43 | (library 44 | (name revproxy) 45 | (public_name ocsigenserver.ext.revproxy) 46 | (modules revproxy) 47 | (libraries ocsigenserver)) 48 | 49 | (library 50 | (name rewritemod) 51 | (public_name ocsigenserver.ext.rewritemod) 52 | (modules rewritemod) 53 | (libraries ocsigenserver)) 54 | 55 | (library 56 | (name staticmod) 57 | (public_name ocsigenserver.ext.staticmod) 58 | (modules staticmod) 59 | (libraries ocsigenserver)) 60 | 61 | (library 62 | (name userconf) 63 | (public_name ocsigenserver.ext.userconf) 64 | (modules userconf) 65 | (libraries ocsigenserver)) 66 | -------------------------------------------------------------------------------- /src/extensions/extendconfiguration.mli: -------------------------------------------------------------------------------- 1 | (** Extendconfiguration: More configuration options for Ocsigen Server *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | +*) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.extendconfiguration]. 13 | *) 14 | 15 | (** Example of use: 16 | {[ 17 | let _ = 18 | Ocsigen_server.start 19 | [ Ocsigen_server.host ~regexp:".*" 20 | [ Extendconfiguration.forbidfile ~extensions:["php"] () 21 | ; Staticmod.run ~dir:"static" () 22 | ] 23 | ] 24 | ]} 25 | *) 26 | 27 | val followsymlinks : 28 | [`Always | `No | `Owner_match] 29 | -> Ocsigen_server.instruction 30 | 31 | val maxuploadfilesize : int64 option -> Ocsigen_server.instruction 32 | val uploaddir : string option -> Ocsigen_server.instruction 33 | val listdirs : bool -> Ocsigen_server.instruction 34 | 35 | val forbidfile : 36 | ?files:string list 37 | -> ?extensions:string list 38 | -> ?regexps:string list 39 | -> unit 40 | -> Ocsigen_server.instruction 41 | 42 | val hidefile : 43 | ?files:string list 44 | -> ?extensions:string list 45 | -> ?regexps:string list 46 | -> unit 47 | -> Ocsigen_server.instruction 48 | 49 | val defaultindex : string list -> Ocsigen_server.instruction 50 | 51 | val contenttype : 52 | ?default:string 53 | -> ?files:(string * string) list 54 | -> ?extensions:(string * string) list 55 | -> ?regexps:(string * string) list 56 | -> unit 57 | -> Ocsigen_server.instruction 58 | 59 | val charset : 60 | ?default:string 61 | -> ?files:(string * string) list 62 | -> ?extensions:(string * string) list 63 | -> ?regexps:(string * string) list 64 | -> unit 65 | -> Ocsigen_server.instruction 66 | -------------------------------------------------------------------------------- /src/extensions/outputfilter.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module outputfilter.ml 4 | * Copyright (C) 2008 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (* This module enables rewritting the server output *) 22 | 23 | let gen filter = function 24 | | Ocsigen_extensions.Req_not_found (code, _) -> 25 | Lwt.return (Ocsigen_extensions.Ext_next code) 26 | | Ocsigen_extensions.Req_found (_ri, res) -> 27 | Lwt.return 28 | @@ Ocsigen_extensions.Ext_found 29 | (fun () -> 30 | Lwt.return 31 | @@ 32 | match filter with 33 | | `Rewrite (header, regexp, dest) -> ( 34 | try 35 | let l = 36 | List.map 37 | (Ocsigen_lib.Netstring_pcre.global_replace regexp dest) 38 | (Ocsigen_response.header_multi res header) 39 | and a = Ocsigen_response.remove_header res header in 40 | Ocsigen_response.add_header_multi a header l 41 | with Not_found -> res) 42 | | `Add (header, dest, replace) -> ( 43 | match replace with 44 | | None -> ( 45 | match Ocsigen_response.header res header with 46 | | Some _ -> res 47 | | None -> Ocsigen_response.add_header res header dest) 48 | | Some false -> Ocsigen_response.add_header res header dest 49 | | Some true -> Ocsigen_response.replace_header res header dest)) 50 | 51 | let gen_code code = function 52 | | Ocsigen_extensions.Req_not_found (code, _) -> 53 | Lwt.return (Ocsigen_extensions.Ext_next code) 54 | | Ocsigen_extensions.Req_found (_ri, res) -> 55 | Lwt.return 56 | @@ Ocsigen_extensions.Ext_found 57 | (fun () -> Lwt.return (Ocsigen_response.set_status res code)) 58 | 59 | let parse_config config_elem = 60 | let header = ref None in 61 | let regexp = ref None in 62 | let dest = ref None in 63 | let replace = ref None in 64 | let code = ref None in 65 | Ocsigen_extensions.( 66 | Configuration.process_element ~in_tag:"host" 67 | ~other_elements:(fun t _ _ -> raise (Bad_config_tag_for_extension t)) 68 | ~elements: 69 | [ Configuration.element ~name:"outputfilter" 70 | ~attributes: 71 | [ Configuration.attribute ~name:"header" (fun s -> 72 | header := Some s) 73 | ; Configuration.attribute ~name:"regexp" (fun s -> 74 | regexp := Some (Ocsigen_lib.Netstring_pcre.regexp s)) 75 | ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) 76 | ; Configuration.attribute ~name:"replace" (fun s -> 77 | try replace := Some (bool_of_string s) 78 | with Invalid_argument _ -> 79 | badconfig 80 | "Wrong value for attribute replace of : %s. It should be true or false" 81 | s) ] 82 | () 83 | ; Configuration.element ~name:"sethttpcode" 84 | ~attributes: 85 | [ Configuration.attribute ~name:"code" (fun s -> 86 | try 87 | match Cohttp.Code.status_of_code (int_of_string s) with 88 | | #Cohttp.Code.status as status -> code := Some status 89 | | `Code _ -> failwith "Invalid code" 90 | with Failure _ -> 91 | badconfig "Invalid code attribute in ") ] 92 | () ] 93 | config_elem); 94 | match !code with 95 | | None -> ( 96 | match !header, !regexp, !dest, !replace with 97 | | _, Some _, _, Some _ -> 98 | Ocsigen_extensions.badconfig 99 | "Wrong attributes for : attributes regexp and replace can't be set simultaneously" 100 | | Some h, Some r, Some d, None -> 101 | gen (`Rewrite (Ocsigen_header.Name.of_string h, r, d)) 102 | | Some h, None, Some d, rep -> 103 | gen (`Add (Ocsigen_header.Name.of_string h, d, rep)) 104 | | _ -> 105 | Ocsigen_extensions.badconfig 106 | "Wrong attributes for " 107 | ) 108 | | Some code -> gen_code code 109 | 110 | let () = 111 | Ocsigen_extensions.register ~name:"outputfilter" 112 | ~fun_site:(fun _ _ _ _ _ _ -> parse_config) 113 | () 114 | 115 | let run ~mode () _ _ _ = 116 | match mode with 117 | | `Code c -> gen_code c 118 | | `Rewrite (header, regexp, dest) -> 119 | gen (`Rewrite (header, Re.Pcre.regexp ("^" ^ regexp ^ "$"), dest)) 120 | | `Add f -> gen (`Add f) 121 | -------------------------------------------------------------------------------- /src/extensions/outputfilter.mli: -------------------------------------------------------------------------------- 1 | (** Outputfilter: Rewrite some part of the output *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | +*) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.outputfilter]. 13 | *) 14 | 15 | (** See an example of use on the API documentation of {!Revproxy}. *) 16 | 17 | val run : 18 | mode: 19 | [ `Rewrite of Ocsigen_header.Name.t * string * string 20 | | `Add of Ocsigen_header.Name.t * string * bool option 21 | | `Code of Cohttp.Code.status ] 22 | -> unit 23 | -> Ocsigen_server.instruction 24 | (** [run ~mode ()] makes it possible to use this extension without 25 | configuration file. *) 26 | -------------------------------------------------------------------------------- /src/extensions/redirectmod.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module redirectmod.ml 4 | * Copyright (C) 2007 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (* Define page redirections in the configuration file *) 22 | 23 | module Pcre = Re.Pcre 24 | 25 | let section = Logs.Src.create "ocsigen:ext:redirectmod" 26 | 27 | (* The table of redirections for each virtual server *) 28 | type redirection = 29 | {r_regexp : Pcre.regexp; r_dest : string; r_full : bool; r_temp : bool} 30 | 31 | let create_redirection ?(full_url = true) ?(temporary = false) ~regexp r_dest = 32 | let r_regexp = Pcre.regexp ("^" ^ regexp ^ "$") in 33 | {r_regexp; r_dest; r_full = full_url; r_temp = temporary} 34 | 35 | let attempt_redir {r_regexp; r_dest; r_full; r_temp} _err ri () = 36 | Logs.info ~src:section (fun fmt -> fmt "Is it a redirection?"); 37 | let redir = Ocsigen_extensions.find_redirection r_regexp r_full r_dest ri in 38 | Logs.info ~src:section (fun fmt -> 39 | fmt "YES! %s redirection to: %s" 40 | (if r_temp then "Temporary " else "Permanent ") 41 | redir); 42 | Lwt.return 43 | @@ Ocsigen_extensions.Ext_found 44 | (fun () -> 45 | Lwt.return @@ Ocsigen_response.make 46 | @@ 47 | let headers = Cohttp.Header.(init_with "Location" redir) 48 | and status = if r_temp then `Found else `Moved_permanently in 49 | Cohttp.Response.make ~status ~headers ()) 50 | 51 | (** The function that will generate the pages from the request *) 52 | let gen dir = function 53 | | Ocsigen_extensions.Req_found _ -> 54 | Lwt.return Ocsigen_extensions.Ext_do_nothing 55 | | Ocsigen_extensions.Req_not_found (err, {Ocsigen_extensions.request_info; _}) 56 | -> ( 57 | Lwt.catch (attempt_redir dir err request_info) @@ function 58 | | Ocsigen_extensions.Not_concerned -> 59 | Lwt.return (Ocsigen_extensions.Ext_next err) 60 | | e -> Lwt.fail e) 61 | 62 | let parse_config config_elem = 63 | let regexp = ref None 64 | and dest = ref "" 65 | and mode = ref true 66 | and temporary = ref false in 67 | Ocsigen_extensions.( 68 | Configuration.process_element ~in_tag:"host" 69 | ~other_elements:(fun t _ _ -> raise (Bad_config_tag_for_extension t)) 70 | ~elements: 71 | [ Configuration.element ~name:"redirect" 72 | ~attributes: 73 | [ Configuration.attribute ~name:"fullurl" (fun s -> 74 | regexp := Some s; 75 | mode := true) 76 | ; Configuration.attribute ~name:"suburl" (fun s -> 77 | regexp := Some s; 78 | mode := false) 79 | ; Configuration.attribute ~name:"dest" ~obligatory:true (fun s -> 80 | dest := s) 81 | ; Configuration.attribute ~name:"temporary" (function 82 | | "temporary" -> temporary := true 83 | | _ -> ()) ] 84 | () ] 85 | config_elem); 86 | match !regexp with 87 | | None -> 88 | Ocsigen_extensions.badconfig "Missing attribute regexp for " 89 | | Some regexp -> 90 | gen 91 | (create_redirection ~full_url:!mode ~regexp ~temporary:!temporary !dest) 92 | 93 | let () = 94 | Ocsigen_extensions.register ~name:"redirectmod" 95 | ~fun_site:(fun _ _ _ _ _ _ -> parse_config) 96 | () 97 | 98 | let run ~redirection () _ _ _ = gen redirection 99 | -------------------------------------------------------------------------------- /src/extensions/redirectmod.mli: -------------------------------------------------------------------------------- 1 | (** Redirectmod: HTTP redirections *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | *) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.redirectmod]. 13 | *) 14 | 15 | (** Example of use: 16 | {[ 17 | let _ = 18 | Ocsigen_server.start 19 | [ Ocsigen_server.host ~regexp:".*" 20 | [ Redirectmod.run 21 | ~redirection: 22 | (Redirectmod.create_redirection 23 | ~temporary:false ~full_url:false ~regexp:"^olddir/(.* )$" 24 | "https://blahblahblah.org/newdir/\\1") 25 | () 26 | ; Staticmod.run ~dir:"static" () 27 | ] 28 | ] 29 | ]} 30 | *) 31 | 32 | val section : Logs.src 33 | 34 | type redirection 35 | 36 | val create_redirection : 37 | ?full_url:bool 38 | -> ?temporary:bool 39 | -> regexp:string 40 | -> string 41 | -> redirection 42 | 43 | val run : redirection:redirection -> unit -> Ocsigen_server.instruction 44 | (** [run ~redirection ()] makes it possible to use this extension without 45 | configuration file. *) 46 | -------------------------------------------------------------------------------- /src/extensions/revproxy.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module revproxy.ml 4 | * Copyright (C) 2007 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Reverse proxy for Ocsigen 22 | 23 | The reverse proxy is still experimental. *) 24 | 25 | open Lwt.Infix 26 | module Pcre = Re.Pcre 27 | 28 | let section = Logs.Src.create "ocsigen:ext:revproxy" 29 | 30 | type redirection = 31 | { regexp : Pcre.regexp 32 | ; full_url : bool 33 | ; dest : string 34 | ; pipeline : bool 35 | ; keephost : bool } 36 | (** The table of redirections for each virtual server *) 37 | 38 | let create_redirection 39 | ?(full_url = true) 40 | ?(pipeline = true) 41 | ?(keephost = false) 42 | ~regexp 43 | dest 44 | = 45 | let regexp = Pcre.regexp ("^" ^ regexp ^ "$") in 46 | {regexp; dest; full_url; pipeline; keephost} 47 | 48 | (** Generate the pages from the request *) 49 | let gen dir = function 50 | | Ocsigen_extensions.Req_found _ -> 51 | Lwt.return Ocsigen_extensions.Ext_do_nothing 52 | | Ocsigen_extensions.Req_not_found (err, {Ocsigen_extensions.request_info; _}) 53 | -> 54 | Lwt.catch 55 | (* Is it a redirection? *) 56 | (fun () -> 57 | Logs.info ~src:section (fun fmt -> fmt "Is it a redirection?"); 58 | let dest = 59 | Ocsigen_extensions.find_redirection dir.regexp dir.full_url 60 | dir.dest request_info 61 | in 62 | let https, host, port, path = 63 | try 64 | (* FIXME: we do not seem to handle GET 65 | parameters. Why? *) 66 | match Ocsigen_lib.Url.parse dest with 67 | | Some https, Some host, port, path, _, _, _ -> 68 | let port = 69 | match port with 70 | | None -> if https then 443 else 80 71 | | Some p -> p 72 | in 73 | https, host, port, path 74 | | _ -> 75 | raise 76 | (Ocsigen_extensions.Error_in_config_file 77 | ("Revproxy : error in destination URL " ^ dest)) 78 | (*VVV catch only URL-related exceptions? *) 79 | with e -> 80 | raise 81 | (Ocsigen_extensions.Error_in_config_file 82 | ("Revproxy : error in destination URL " ^ dest ^ " - " 83 | ^ Printexc.to_string e)) 84 | in 85 | Logs.info ~src:section (fun fmt -> 86 | fmt "YES! Redirection to http%s://%s:%d/%s" 87 | (if https then "s" else "") 88 | host port path); 89 | Ocsigen_lib.Ip_address.get_inet_addr host >>= fun _inet_addr -> 90 | (* It is now safe to start processing next request. 91 | 92 | We are sure that the request won't be taken in disorder, 93 | so we return. *) 94 | let do_request () = 95 | let headers = 96 | let h = 97 | Cohttp.Request.headers (Ocsigen_request.to_cohttp request_info) 98 | in 99 | let h = 100 | Ocsigen_request.version request_info 101 | |> Cohttp.Code.string_of_version 102 | |> Cohttp.Header.replace h 103 | Ocsigen_header.Name.(to_string x_forwarded_proto) 104 | in 105 | let h = 106 | let forward = 107 | let address = 108 | Ocsigen_config.Socket_type.to_string 109 | (Ocsigen_request.address request_info) 110 | in 111 | String.concat ", " 112 | (Ocsigen_request.remote_ip request_info 113 | :: Ocsigen_request.forward_ip request_info 114 | @ [address]) 115 | in 116 | Cohttp.Header.replace h 117 | Ocsigen_header.Name.(to_string x_forwarded_for) 118 | forward 119 | in 120 | Cohttp.Header.remove h Ocsigen_header.Name.(to_string host) 121 | and uri = 122 | let scheme = 123 | if Ocsigen_request.ssl request_info then "https" else "http" 124 | and host = 125 | match 126 | if dir.keephost 127 | then Ocsigen_request.host request_info 128 | else None 129 | with 130 | | Some host -> host 131 | | None -> host 132 | in 133 | Uri.make ~scheme ~host ~port ~path () 134 | and body = Ocsigen_request.body request_info 135 | and meth = Ocsigen_request.meth request_info in 136 | Cohttp_lwt_unix.Client.call ~headers ~body meth uri 137 | in 138 | Lwt.return 139 | @@ Ocsigen_extensions.Ext_found 140 | (fun () -> do_request () >|= Ocsigen_response.of_cohttp)) 141 | (function 142 | | Ocsigen_extensions.Not_concerned -> 143 | Lwt.return (Ocsigen_extensions.Ext_next err) 144 | | e -> Lwt.fail e) 145 | 146 | let parse_config config_elem = 147 | let regexp = ref None in 148 | let full_url = ref true in 149 | let dest = ref None in 150 | let pipeline = ref true in 151 | let keephost = ref false in 152 | Ocsigen_extensions.( 153 | Configuration.process_element ~in_tag:"host" 154 | ~other_elements:(fun t _ _ -> raise (Bad_config_tag_for_extension t)) 155 | ~elements: 156 | [ Configuration.element ~name:"revproxy" 157 | ~attributes: 158 | [ Configuration.attribute ~name:"fullurl" (fun s -> 159 | regexp := Some s; 160 | full_url := true) 161 | ; Configuration.attribute ~name:"suburl" (fun s -> 162 | regexp := Some s; 163 | full_url := false) 164 | ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) 165 | ; Configuration.attribute ~name:"keephost" (function 166 | | "keephost" -> keephost := true 167 | | _ -> ()) 168 | ; Configuration.attribute ~name:"nopipeline" (function 169 | | "nopipeline" -> pipeline := false 170 | | _ -> ()) ] 171 | () ] 172 | config_elem); 173 | match !regexp, !full_url, !dest, !pipeline, !keephost with 174 | | None, _, _, _, _ -> 175 | Ocsigen_extensions.badconfig "Missing attribute 'regexp' for " 176 | | _, _, None, _, _ -> 177 | Ocsigen_extensions.badconfig "Missing attribute 'dest' for " 178 | | Some regexp, full_url, Some dest, pipeline, keephost -> 179 | gen 180 | { regexp = Ocsigen_lib.Netstring_pcre.regexp ("^" ^ regexp ^ "$") 181 | ; full_url 182 | ; dest 183 | ; pipeline 184 | ; keephost } 185 | 186 | let () = 187 | Ocsigen_extensions.register ~name:"revproxy" 188 | ~fun_site:(fun _ _ _ _ _ _ -> parse_config) 189 | ~respect_pipeline:true 190 | (* We ask ocsigen to respect pipeline order 191 | when sending to extensions! *) 192 | () 193 | 194 | let run ~redirection () _ _ _ = gen redirection 195 | -------------------------------------------------------------------------------- /src/extensions/revproxy.mli: -------------------------------------------------------------------------------- 1 | (** Revproxy: Forward a request to another Web server *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | *) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.revproxy]. 13 | *) 14 | 15 | (** Example of use. Forward all requests to a given directory to the 16 | same directory of another server running locally on another port. 17 | We are using it in combination with 18 | {% <>%} to rewrite redirections. 19 | 20 | {[ 21 | let _ = 22 | Ocsigen_server.start 23 | [ Ocsigen_server.host ~regexp:".*" 24 | [ Revproxy.run 25 | ~redirection:(Revproxy.create_redirection 26 | ~full_url:false 27 | ~regexp:"(othersite/.* )" 28 | ~keephost:true 29 | "https://localhost:8123/\\1") 30 | () 31 | ; Outputfilter.run 32 | ~mode:(`Rewrite (Ocsigen_header.Name.location, 33 | "http://localhost:8123/(.* )", 34 | "http://my.publicaddress.org/\\1")) 35 | () 36 | ]] 37 | ]} 38 | *) 39 | 40 | val section : Logs.src 41 | 42 | type redirection 43 | 44 | val create_redirection : 45 | ?full_url:bool 46 | -> ?pipeline:bool 47 | -> ?keephost:bool 48 | -> regexp:string 49 | -> string 50 | -> redirection 51 | 52 | val run : redirection:redirection -> unit -> Ocsigen_server.instruction 53 | (** [run ~redirection ()] makes it possible to use this extension without 54 | configuration file. *) 55 | -------------------------------------------------------------------------------- /src/extensions/rewritemod.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module rewritemod.ml 4 | * Copyright (C) 2008 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (* Rewrite URLs in the configuration file *) 22 | 23 | module Pcre = Re.Pcre 24 | 25 | (* IMPORTANT WARNING 26 | 27 | It is really basic for now: 28 | - rewrites only subpaths (and doees not change get parameters) 29 | - changes only ri_sub_path and ri_sub_path_string 30 | not ri_full_path, nor ri_full_path_string, nor ri_url_string, nor ri_url 31 | 32 | This is probably NOT what we want... *) 33 | 34 | let section = Logs.Src.create "ocsigen:ext:rewritemod" 35 | 36 | exception Not_concerned 37 | 38 | (* The table of rewrites for each virtual server *) 39 | type assockind = Regexp of Pcre.regexp * string * bool 40 | 41 | let find_rewrite (Regexp (regexp, dest, fullrewrite)) suburl = 42 | ( (match Ocsigen_lib.Netstring_pcre.string_match regexp suburl 0 with 43 | | None -> raise Not_concerned 44 | | Some _ -> 45 | (* Matching regexp found! *) 46 | Ocsigen_lib.Netstring_pcre.global_replace regexp dest suburl) 47 | , fullrewrite ) 48 | 49 | (* The function that will generate the pages from the request *) 50 | let gen regexp continue = function 51 | | Ocsigen_extensions.Req_found _ -> 52 | Lwt.return Ocsigen_extensions.Ext_do_nothing 53 | | Ocsigen_extensions.Req_not_found (err, ri) -> 54 | let try_block () = 55 | Logs.info ~src:section (fun fmt -> fmt "Is it a rewrite?"); 56 | let redir, full_rewrite = 57 | let ri = ri.Ocsigen_extensions.request_info in 58 | find_rewrite regexp 59 | (match Ocsigen_request.query ri with 60 | | None -> Ocsigen_request.sub_path_string ri 61 | | Some g -> Ocsigen_request.sub_path_string ri ^ "?" ^ g) 62 | in 63 | Logs.info ~src:section (fun fmt -> fmt "YES! rewrite to: %s" redir); 64 | if continue 65 | then 66 | Lwt.return 67 | @@ Ocsigen_extensions.Ext_continue_with 68 | ( { ri with 69 | Ocsigen_extensions.request_info = 70 | Ocsigen_request.update ~full_rewrite 71 | ~uri:(Uri.of_string redir) 72 | ri.Ocsigen_extensions.request_info } 73 | , Ocsigen_cookie_map.empty 74 | , err ) 75 | else 76 | Lwt.return 77 | @@ Ocsigen_extensions.Ext_retry_with 78 | ( { ri with 79 | Ocsigen_extensions.request_info = 80 | Ocsigen_request.update ~full_rewrite 81 | ~uri:(Uri.of_string redir) 82 | ri.Ocsigen_extensions.request_info } 83 | , Ocsigen_cookie_map.empty ) 84 | and catch_block = function 85 | | Ocsigen_extensions.Not_concerned -> 86 | Lwt.return (Ocsigen_extensions.Ext_next err) 87 | | e -> Lwt.fail e 88 | in 89 | Lwt.catch try_block catch_block 90 | 91 | let parse_config element = 92 | let regexp = ref "" in 93 | let dest = ref None in 94 | let fullrewrite = ref false in 95 | let continue = ref false in 96 | Ocsigen_extensions.( 97 | Configuration.process_element ~in_tag:"host" 98 | ~other_elements:(fun t _ _ -> raise (Bad_config_tag_for_extension t)) 99 | ~elements: 100 | [ Configuration.element ~name:"rewrite" 101 | ~attributes: 102 | [ Configuration.attribute ~name:"regexp" ~obligatory:true (fun s -> 103 | regexp := s) 104 | ; Configuration.attribute ~name:"url" (fun s -> dest := Some s) 105 | ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) 106 | ; Configuration.attribute ~name:"fullrewrite" (fun s -> 107 | fullrewrite := s = "fullrewrite" || s = "true") 108 | ; Configuration.attribute ~name:"continue" (fun s -> 109 | continue := s = "continue" || s = "true") ] 110 | () ] 111 | element); 112 | match !dest with 113 | | None -> 114 | raise 115 | (Ocsigen_extensions.Error_in_config_file 116 | "url attribute expected for ") 117 | | Some dest -> 118 | gen 119 | (Regexp 120 | ( Ocsigen_lib.Netstring_pcre.regexp ("^" ^ !regexp ^ "$") 121 | , dest 122 | , !fullrewrite )) 123 | !continue 124 | 125 | (** Registration of the extension *) 126 | let () = 127 | Ocsigen_extensions.register ~name:"rewritemod" 128 | ~fun_site:(fun _ _ _ _ _ _ -> parse_config) 129 | () 130 | 131 | let run ?(continue = false) ?(full_rewrite = false) ~regexp dest () _ _ _ = 132 | gen 133 | (Regexp 134 | ( Ocsigen_lib.Netstring_pcre.regexp ("^" ^ regexp ^ "$") 135 | , dest 136 | , full_rewrite )) 137 | continue 138 | -------------------------------------------------------------------------------- /src/extensions/rewritemod.mli: -------------------------------------------------------------------------------- 1 | (** Rewrite: Change the request *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. Each of these functions behaves exactly as its configuration file 7 | counterpart. 8 | +*) 9 | 10 | (** 11 | This module belongs to ocamlfind package 12 | [ocsigenserver.ext.rewritemod]. 13 | *) 14 | 15 | val section : Logs.src 16 | 17 | val run : 18 | ?continue:bool 19 | -> ?full_rewrite:bool 20 | -> regexp:string 21 | -> string 22 | -> unit 23 | -> Ocsigen_server.instruction 24 | (** [run ~realm ~auth ()] makes it possible to use this extension without 25 | configuration file. *) 26 | -------------------------------------------------------------------------------- /src/extensions/staticmod.mli: -------------------------------------------------------------------------------- 1 | (** Staticmod: serve static files *) 2 | 3 | (** If you want to use this extension with Ocsigen Server's configuration file, 4 | have a look at the {% <>%}. 5 | If you are using Ocsigen Server as a library, use the interface described 6 | here. 7 | *) 8 | 9 | (** 10 | This module belongs to ocamlfind package 11 | [ocsigenserver.ext.staticmod]. 12 | *) 13 | 14 | (** Example of use: 15 | {[ 16 | let _ = 17 | Ocsigen_server.start 18 | [ Ocsigen_server.host ~regexp:".*" [ Staticmod.run ~dir:"static" () ]] 19 | ]} 20 | *) 21 | 22 | val run : 23 | ?dir:string 24 | -> ?regexp:string 25 | -> ?dest:string 26 | -> ?code:string 27 | -> ?cache:int 28 | -> ?root:string 29 | -> unit 30 | -> Ocsigen_server.instruction 31 | (** Run static mod on a specific directory. 32 | Call this if you want to run Ocsigen Server without configuration file. 33 | The optional parameter correspond to the options of the configuration 34 | file described {% <>%}.*) 35 | 36 | val section : Logs.src 37 | -------------------------------------------------------------------------------- /src/extensions/userconf.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocsigen/ocsigenserver/06ad0a840226775a8434e65abf400ba97641c3f9/src/extensions/userconf.mli -------------------------------------------------------------------------------- /src/files/logrotate.in: -------------------------------------------------------------------------------- 1 | LOGDIR/*.log { 2 | weekly 3 | missingok 4 | rotate 52 5 | compress 6 | delaycompress 7 | notifempty 8 | create 640 USER GROUP 9 | sharedscripts 10 | postrotate 11 | if fuser -s _COMMANDPIPE_; then 12 | echo reopen_logs > _COMMANDPIPE_ 13 | fi 14 | endscript 15 | } 16 | -------------------------------------------------------------------------------- /src/files/ocsigenserver.1: -------------------------------------------------------------------------------- 1 | .\" Hey, EMACS: -*- nroff -*- 2 | .TH OCSIGEN 1 2006-09-14 3 | .SH NAME 4 | ocsigen \- web programming framework in OCaml 5 | .SH SYNOPSIS 6 | .B ocsigen 7 | .RI [ options ] 8 | .SH DESCRIPTION 9 | .B ocsigen 10 | is a programming framework providing a new way to create dynamic web sites. 11 | Its goal is to offer an alternative to Apache/PHP, based on cutting-edge 12 | technologies coming from research in programming languages. 13 | With 14 | .BR ocsigen , 15 | you program in a concise and modular way, with a strong type system 16 | which helps you to produce valid xhtml. The server handles sessions, 17 | URLs, and page parameters automatically. 18 | .SH OPTIONS 19 | .TP 20 | .BR \-c ,\ \-\-config 21 | Alternate configuration file. 22 | .TP 23 | .BR \-d ,\ \-\-daemon 24 | Daemon mode (detach the process). This is the default when there are more than 1 process. 25 | .TP 26 | .BR \-help ,\ \-\-help 27 | Show summary of options. 28 | .TP 29 | .BR \-p ,\ \-\-pidfile 30 | Specify a file where to write the PIDs of the servers. 31 | .TP 32 | .BR \-s ,\ \-\-silent 33 | Silent mode (error messages go in errors.log only). 34 | .TP 35 | .BR \-v ,\ \-\-verbose 36 | Verbose mode (notice). 37 | .TP 38 | .B \-vv ,\ \-\-veryverbose 39 | Very verbose mode (info). 40 | .TP 41 | .B \-vvv ,\ \-\-debug 42 | Extremely verbose mode (debug). 43 | .TP 44 | .B \-\-version 45 | Show version of program. 46 | .SH SEE ALSO 47 | .BR ocamlc (1). 48 | .SH AUTHOR 49 | ocsigen was written by Vincent Balat . 50 | .PP 51 | This manual page was written by Samuel Mimram , 52 | for the Debian project (but may be used by others). 53 | -------------------------------------------------------------------------------- /src/files/ocsigenserver.conf/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name gen) 3 | (libraries str unix)) 4 | -------------------------------------------------------------------------------- /src/files/ocsigenserver.conf/gen.ml: -------------------------------------------------------------------------------- 1 | let conf_in = 2 | {| 3 | 5 | 7 | 8 | 9 | 10 | 11 | 12 | _PORT_ 13 | 14 | _LOGDIR_ 15 | _DATADIR_ 16 | _COMMANDPIPE_ 17 | _MIMEFILE_ 18 | 19 | utf-8 20 | 21 | _FINDLIBEXTRA_ 22 | 23 | 24 | 25 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | |} 42 | 43 | let conf_ml = 44 | {|(* Warning: this file has been generated - DO NOT MODIFY! *) 45 | 46 | let version_number = _VERSION_ 47 | let config_file = ref _CONFIGFILE_ 48 | let is_native = Sys.backend_type = Sys.Native 49 | let logdir = ref (Some _LOGDIR_) 50 | let mimefile = ref _MIMEFILE_ 51 | let datadir = ref _DATADIR_ 52 | let bindir = ref _BINDIR_ 53 | let extdir = ref _EXTDIR_ 54 | let command_pipe = ref _COMMANDPIPE_ 55 | let builtin_packages = 56 | List.fold_left 57 | (fun a s -> Ocsigen_lib.String.Set.add s a) 58 | Ocsigen_lib.String.Set.empty 59 | [_DEPS_]|} 60 | 61 | let interpolate f s = 62 | let regexp = Str.regexp "_\\([A-Z]+\\)_" in 63 | let f s = f (Str.matched_group 1 s) in 64 | Str.global_substitute regexp f s 65 | 66 | open Options 67 | 68 | let libdir () = 69 | if libdir_set = 0 70 | then ( 71 | let inp = Unix.open_process_in "ocamlfind printconf destdir" in 72 | let libdir = input_line inp in 73 | ignore (Unix.close_process_in inp); 74 | libdir) 75 | else libdir 76 | 77 | let deps () = 78 | let extra_deps = 79 | [ "ocsigenserver.polytables" 80 | ; "ocsigenserver.cookies" 81 | ; "ocsigenserver.baselib.base" 82 | ; "ocsigenserver.baselib" 83 | ; "ocsigenserver.http" 84 | ; "ocsigenserver" ] 85 | in 86 | let packages = 87 | "lwt_ssl,bytes,lwt.unix,logs,logs-syslog.unix,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix" 88 | in 89 | let deps = ref [] in 90 | let cmd = "ocamlfind query -p-format -recursive " ^ packages in 91 | let inp = Unix.open_process_in cmd in 92 | (try 93 | while true do 94 | deps := input_line inp :: !deps 95 | done 96 | with End_of_file -> ()); 97 | match Unix.close_process_in inp with 98 | | WEXITED 0 -> !deps @ extra_deps 99 | | _ -> failwith ("Command failed: " ^ cmd) 100 | 101 | (* Encode a string as a string literal that can be included in an ocaml file. *) 102 | let str = Printf.sprintf "%S" 103 | let ( // ) = Filename.concat 104 | 105 | let static_options = function 106 | | "VERSION" -> str version 107 | | "LOGDIR" -> str logdir 108 | | "DATADIR" -> str datadir 109 | | "BINDIR" -> str bindir 110 | | "EXTDIR" -> str (libdir () // "ocsigenserver" // "extensions") 111 | | "STATICPAGESDIR" -> str staticpagesdir 112 | | "UP" -> str uploaddir 113 | | "COMMANDPIPE" -> str commandpipe 114 | | "CONFIGDIR" -> str configdir 115 | | "CONFIGFILE" -> str (configdir // "ocsigenserver.conf") 116 | | "MIMEFILE" -> str (configdir // "mime.types") 117 | | "DEPS" -> String.concat ";" (List.map (Format.asprintf "%S") (deps ())) 118 | | _ as s -> failwith s 119 | 120 | let sample_options = function 121 | | "PORT" -> string_of_int port 122 | | "LOGDIR" -> logdir 123 | | "DATADIR" -> datadir 124 | | "COMMANDPIPE" -> "" 125 | | "MIMEFILE" -> "" 126 | | "LIBDIR" | "METADIR" -> libdir () 127 | | "EXTPACKAGENAME" -> "ocsigenserver.ext" 128 | | "CONFIGDIR" -> configdir 129 | | "STATICPAGESDIR" -> staticpagesdir 130 | | "FINDLIBEXTRA" -> "" 131 | | _ as s -> failwith s 132 | 133 | let local_options = function 134 | | "PORT" -> "8080" 135 | | "LOGDIR" -> src ^ "/local/var/log" 136 | | "DATADIR" -> src ^ "/local/var/lib" 137 | | "COMMANDPIPE" -> 138 | "" ^ src 139 | ^ "/local/var/run/ocsigenserver_command" 140 | | "MIMEFILE" -> "" ^ src ^ "/src/files/mime.types" 141 | | "LIBDIR" | "METADIR" -> libdir () 142 | | "EXTPACKAGENAME" -> "ocsigenserver.ext" 143 | | "CONFIGDIR" -> src ^ "/local/etc/ocsigenserver" 144 | | "STATICPAGESDIR" -> src ^ "/local/var/www" 145 | | "FINDLIBEXTRA" -> 146 | "" 148 | | _ as s -> failwith s 149 | 150 | let () = 151 | let arg = if Array.length Sys.argv > 1 then Sys.argv.(1) else "" in 152 | print_endline 153 | @@ 154 | match arg with 155 | | "static.ml" -> interpolate static_options conf_ml 156 | | "local" -> interpolate local_options conf_in 157 | | "sample" -> interpolate sample_options conf_in 158 | | _ -> failwith arg 159 | -------------------------------------------------------------------------------- /src/files/ocsigenserver.conf/options.ml: -------------------------------------------------------------------------------- 1 | let version = "dev" 2 | let src = "" 3 | let port = 80 4 | let bindir = "" 5 | let libdir = "" 6 | let libdir_set = 0 7 | let logdir = "" 8 | let configdir = "" 9 | let staticpagesdir = "" 10 | let datadir = "" 11 | let uploaddir = "" 12 | let commandpipe = "" 13 | let mimefile = "" 14 | -------------------------------------------------------------------------------- /src/http/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ocsigen_cookie_map) 3 | (public_name ocsigenserver.cookies) 4 | (modules ocsigen_cookie_map) 5 | (libraries ocsigen_lib_base)) 6 | 7 | (library 8 | (name ocsigen_http) 9 | (public_name ocsigenserver.http) 10 | (wrapped false) 11 | (modules ocsigen_charset_mime ocsigen_header) 12 | (libraries cohttp-lwt-unix baselib logs)) 13 | -------------------------------------------------------------------------------- /src/http/ocsigen_charset_mime.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * ocsigen_charset_mime.ml Copyright (C) 2008 4 | * Boris Yakobowski 5 | * Laboratoire PPS - CNRS Université Paris Diderot 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | open Ocsigen_lib 23 | module MapString = Map.Make (String) 24 | 25 | type extension = string 26 | type filename = string 27 | type file = string 28 | 29 | let section = Logs.Src.create "ocsigen:mimetype" 30 | 31 | type 'a assoc_item = 32 | | Extension of extension * 'a 33 | | File of filename * 'a 34 | | Regexp of Re.Pcre.regexp * 'a 35 | | Map of 'a MapString.t 36 | 37 | type 'a assoc = {assoc_list : 'a assoc_item list; assoc_default : 'a} 38 | 39 | let find_in_assoc file assoc = 40 | let filename = Filename.basename file in 41 | let ext = 42 | try String.lowercase_ascii (Filename.extension_no_directory file) 43 | with Not_found -> "" 44 | in 45 | let rec aux = function 46 | | [] -> assoc.assoc_default 47 | | Extension (ext', v) :: q -> if ext = ext' then v else aux q 48 | | File (filename', v) :: q -> if filename = filename' then v else aux q 49 | | Regexp (reg, v) :: q -> 50 | if Netstring_pcre.string_match reg file 0 <> None then v else aux q 51 | | Map m :: q -> ( try MapString.find ext m with Not_found -> aux q) 52 | in 53 | aux assoc.assoc_list 54 | 55 | let default assoc = assoc.assoc_default 56 | let set_default assoc default = {assoc with assoc_default = default} 57 | 58 | let update_ext assoc (ext : extension) v = 59 | { assoc with 60 | assoc_list = Extension (String.lowercase_ascii ext, v) :: assoc.assoc_list 61 | } 62 | 63 | let update_file assoc (file : filename) v = 64 | {assoc with assoc_list = File (file, v) :: assoc.assoc_list} 65 | 66 | let update_regexp assoc r v = 67 | {assoc with assoc_list = Regexp (r, v) :: assoc.assoc_list} 68 | 69 | let empty default () = {assoc_list = []; assoc_default = default} 70 | 71 | (* Handling of charset and mime ; specific values and declarations *) 72 | 73 | type charset = string 74 | type mime_type = string 75 | type charset_assoc = charset assoc 76 | type mime_assoc = mime_type assoc 77 | 78 | let no_charset : charset = "" 79 | let default_mime_type : mime_type = "application/octet-stream" 80 | let empty_charset_assoc ?(default = no_charset) = empty default 81 | let empty_mime_assoc ?(default = default_mime_type) = empty default 82 | 83 | (* Generic functions *) 84 | 85 | let default_charset = default 86 | let default_mime = default 87 | let update_charset_ext = update_ext 88 | let update_mime_ext = update_ext 89 | let update_charset_file = update_file 90 | let update_mime_file = update_file 91 | let update_charset_regexp = update_regexp 92 | let update_mime_regexp = update_regexp 93 | let set_default_mime = set_default 94 | let set_default_charset = set_default 95 | let find_charset = find_in_assoc 96 | let find_mime = find_in_assoc 97 | 98 | (* Specific handling of content-type *) 99 | 100 | let parse_mime_types ~filename : mime_type assoc = 101 | let rec read_and_split mimemap in_ch = 102 | try 103 | let line = input_line in_ch in 104 | let line_upto = 105 | try 106 | let upto = String.index line '#' in 107 | String.sub line 0 upto 108 | with Not_found -> line 109 | in 110 | let strlist = 111 | Netstring_pcre.split (Netstring_pcre.regexp "\\s+") line_upto 112 | in 113 | match strlist with 114 | | [] | [_] -> (* No extension on this line *) read_and_split mimemap in_ch 115 | | mime :: extensions -> 116 | let mimemap = 117 | List.fold_left 118 | (fun mimemap ext -> MapString.add ext mime mimemap) 119 | mimemap extensions 120 | in 121 | read_and_split mimemap in_ch 122 | with End_of_file -> mimemap 123 | in 124 | { assoc_list = 125 | [ Map 126 | (try 127 | let in_ch = open_in filename in 128 | let map = 129 | try read_and_split MapString.empty in_ch 130 | with e -> close_in in_ch; raise e 131 | in 132 | close_in in_ch; map 133 | with exn -> 134 | Logs.err ~src:section (fun fmt -> 135 | fmt 136 | ("unable to read the mime.types file" ^^ "@\n%s") 137 | (Printexc.to_string exn)); 138 | MapString.empty) ] 139 | ; assoc_default = default_mime_type } 140 | 141 | let default_mime_assoc () = 142 | let parsed = ref None in 143 | match !parsed with 144 | | None -> 145 | let filename = !Ocsigen_config_static.mimefile in 146 | Logs.info ~src:section (fun fmt -> 147 | fmt "Loading mime types in '%s'" filename); 148 | let map = parse_mime_types ~filename in 149 | parsed := Some map; 150 | map 151 | | Some map -> map 152 | -------------------------------------------------------------------------------- /src/http/ocsigen_charset_mime.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * ocsigen_charset_mime.mli Copyright (C) 2008 4 | * Boris Yakobowski 5 | * Laboratoire PPS - CNRS Université Paris Diderot 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | type extension = string 23 | type file = string 24 | type filename = string 25 | 26 | (** Charset *) 27 | 28 | type charset = string 29 | (** By convention, "no specified charset" is represented by the empty 30 | string *) 31 | 32 | val no_charset : charset 33 | 34 | type charset_assoc 35 | (** Association between extensions and charset, with a default value. *) 36 | 37 | val empty_charset_assoc : ?default:charset -> unit -> charset_assoc 38 | (** All files are mapped to [no_charset] *) 39 | 40 | val empty_mime_assoc : ?default:charset -> unit -> charset_assoc 41 | val find_charset : string -> charset_assoc -> charset 42 | 43 | val default_charset : charset_assoc -> charset 44 | (** Functions related to the default charset in the association *) 45 | 46 | val set_default_charset : charset_assoc -> charset -> charset_assoc 47 | 48 | val update_charset_ext : charset_assoc -> extension -> charset -> charset_assoc 49 | (** Updates the mapping between extensions from a file to its charset. 50 | The update can be specified using the extension of the file, 51 | the name of the file, or the entire file (with its path) 52 | *) 53 | 54 | val update_charset_file : charset_assoc -> filename -> charset -> charset_assoc 55 | 56 | val update_charset_regexp : 57 | charset_assoc 58 | -> Re.Pcre.regexp 59 | -> charset 60 | -> charset_assoc 61 | 62 | type mime_type = string 63 | (** MIME types; the default value is ["application/octet-stream"] *) 64 | 65 | val default_mime_type : mime_type 66 | 67 | type mime_assoc 68 | (** association between extensions and mime types, with default value *) 69 | 70 | val default_mime_assoc : unit -> mime_assoc 71 | (** Default values, obtained by reading the file specified by 72 | [Ocsigen_config_static.get_mimefile] *) 73 | 74 | val parse_mime_types : filename:string -> mime_assoc 75 | (** Parsing of a file containing mime associations, such as /etc/mime-types *) 76 | 77 | (* The other functions are as for charsets *) 78 | 79 | val find_mime : file -> mime_assoc -> string 80 | val default_mime : mime_assoc -> mime_type 81 | val set_default_mime : mime_assoc -> mime_type -> mime_assoc 82 | val update_mime_ext : mime_assoc -> extension -> mime_type -> mime_assoc 83 | val update_mime_file : mime_assoc -> filename -> mime_type -> mime_assoc 84 | val update_mime_regexp : mime_assoc -> Re.Pcre.regexp -> mime_type -> mime_assoc 85 | -------------------------------------------------------------------------------- /src/http/ocsigen_cookie_map.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2010 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | module Map_path = Map.Make (struct 20 | type t = string list 21 | 22 | let compare = compare 23 | end) 24 | 25 | module Map_inner = Map.Make (String) 26 | 27 | type cookie = OSet of float option * string * bool | OUnset 28 | type t = cookie Map_inner.t Map_path.t 29 | 30 | let empty = Map_path.empty 31 | 32 | let add ~path n v m = 33 | let m' = try Map_path.find path m with Not_found -> Map_inner.empty in 34 | (* We replace the old value if it exists *) 35 | Map_path.add path (Map_inner.add n v m') m 36 | 37 | (* [add_multi new old] adds the cookies from [new] to [old]. If 38 | cookies are already bound in oldcookies, the previous binding 39 | disappear. *) 40 | let add_multi = 41 | Map_path.fold @@ fun path -> 42 | Map_inner.fold @@ fun n v beg -> 43 | match v with 44 | | OSet (expo, v, secure) -> add ~path n (OSet (expo, v, secure)) beg 45 | | OUnset -> add ~path n OUnset beg 46 | 47 | let remove ~path n m = 48 | try 49 | let m' = Map_path.find path m in 50 | let m' = Map_inner.remove n m' in 51 | if Map_inner.is_empty m' 52 | then Map_path.remove path m 53 | else (* We replace the old value *) 54 | Map_path.add path m' m 55 | with Not_found -> m 56 | 57 | module Poly = struct 58 | let add = add 59 | let remove = remove 60 | end 61 | -------------------------------------------------------------------------------- /src/http/ocsigen_cookie_map.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2010 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | module Map_path : Map.S with type key := Ocsigen_lib_base.Url_base.path 20 | (** This type of maps is used to store cookie values for each 21 | path. The key has type Url.path option: it is for the path 22 | (default: root of the site). *) 23 | 24 | module Map_inner : Map.S with type key := string 25 | 26 | (** Type used for cookies to set. The float option is the timestamp 27 | for the expiration date. The string is the value. If the bool is 28 | true and the protocol is https, the cookie will be secure (will ask 29 | the browser to send it only through secure connections). *) 30 | type cookie = OSet of float option * string * bool | OUnset 31 | 32 | type t = cookie Map_inner.t Map_path.t 33 | 34 | val empty : t 35 | 36 | val add : path:Ocsigen_lib_base.Url_base.path -> string -> cookie -> t -> t 37 | (** [add ~path c v m] adds the cookie [c] to [m]. 38 | 39 | If the cookie is already bound, the previous binding disappear. *) 40 | 41 | val add_multi : t -> t -> t 42 | (** [add_multi new old] adds the cookies from [new] to [old]. If 43 | cookies are already bound in oldcookies, the previous binding 44 | disappear. *) 45 | 46 | val remove : path:Ocsigen_lib_base.Url_base.path -> string -> t -> t 47 | (** [remove c cookie_table] removes the cookie [c] from [m]. 48 | 49 | Warning: it is not equivalent to [add ... OUnset ...]). *) 50 | 51 | (** Polymorphic versions of [add] and [remove] to use when we don't need to 52 | OUnset (client-side) *) 53 | module Poly : sig 54 | val add : 55 | path:Ocsigen_lib_base.Url_base.path 56 | -> string 57 | -> 'a 58 | -> 'a Map_inner.t Map_path.t 59 | -> 'a Map_inner.t Map_path.t 60 | 61 | val remove : 62 | path:Ocsigen_lib_base.Url_base.path 63 | -> string 64 | -> 'a Map_inner.t Map_path.t 65 | -> 'a Map_inner.t Map_path.t 66 | end 67 | -------------------------------------------------------------------------------- /src/http/ocsigen_header.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | type t = Cohttp.Header.t 20 | 21 | let of_option = function Some h -> h | None -> Cohttp.Header.init () 22 | 23 | module Name = struct 24 | type t = string 25 | 26 | let of_string = String.lowercase_ascii 27 | let to_string s = s 28 | let accept = of_string "Accept" 29 | let accept_charset = of_string "Accept-Charset" 30 | let accept_encoding = of_string "Accept-Encoding" 31 | let accept_language = of_string "Accept-Language" 32 | let accept_ranges = of_string "Accept-Ranges" 33 | let authorization = of_string "Authorization" 34 | let cache_control = of_string "Cache-Control" 35 | let connection = of_string "Connection" 36 | let content_disposition = of_string "Content-Disposition" 37 | let content_encoding = of_string "Content-Encoding" 38 | let content_range = of_string "Content-Range" 39 | let content_length = of_string "Content-Length" 40 | let content_type = of_string "Content-Type" 41 | let cookie = of_string "Cookie" 42 | let date = of_string "Date" 43 | let etag = of_string "ETag" 44 | let expect = of_string "Expect" 45 | let expires = of_string "Expires" 46 | let host = of_string "Host" 47 | let if_match = of_string "If-Match" 48 | let if_modified_since = of_string "If-Modified-Since" 49 | let if_none_match = of_string "If-None-Match" 50 | let if_unmodified_since = of_string "If-Unmodified-Since" 51 | let if_range = of_string "If-Range" 52 | let last_modified = of_string "Last-Modified" 53 | let location = of_string "Location" 54 | let pragma = of_string "Pragma" 55 | let server = of_string "Server" 56 | let set_cookie = of_string "Set-Cookie" 57 | let status = of_string "Status" 58 | let transfer_encoding = of_string "Transfer-Encoding" 59 | let user_agent = of_string "User-Agent" 60 | let referer = of_string "Referer" 61 | let range = of_string "Range" 62 | let x_forwarded_for = of_string "X-Forwarded-For" 63 | let x_forwarded_proto = of_string "X-Forwarded-Proto" 64 | 65 | (* CORS headers *) 66 | let origin = of_string "Origin" 67 | let access_control_request_method = of_string "Access-Control-Request-Method" 68 | 69 | let access_control_request_headers = 70 | of_string "Access-Control-Request-Headers" 71 | 72 | let access_control_allow_origin = of_string "Access-Control-Allow-Origin" 73 | 74 | let access_control_allow_credentials = 75 | of_string "Access-Control-Allow-Credentials" 76 | 77 | let access_control_expose_headers = of_string "Access-Control-Expose-Headers" 78 | let access_control_max_age = of_string "Access-Control-Max-Age" 79 | let access_control_allow_methods = of_string "Access-Control-Allow-Methods" 80 | let access_control_allow_headers = of_string "Access-Control-Allow-Headers" 81 | end 82 | 83 | let parse_star a = if a = "*" then None else Some a 84 | 85 | let parse_quality f s = 86 | try 87 | let a, b = Ocsigen_lib.String.sep ';' s in 88 | let q, qv = Ocsigen_lib.String.sep '=' b in 89 | if q = "q" then f a, Some (float_of_string qv) else failwith "Parse error" 90 | with _ -> f s, None 91 | 92 | module Mime_type = struct 93 | type t = string option * string option 94 | 95 | let parse a = 96 | let b, c = Ocsigen_lib.String.sep '/' a in 97 | parse_star b, parse_star c 98 | end 99 | 100 | module Accept = struct 101 | type t = (Mime_type.t * float option * (string * string) list) list 102 | 103 | let parse_extensions parse_name s = 104 | try 105 | let a, b = Ocsigen_lib.String.sep ';' s in 106 | ( parse_name a 107 | , List.map (Ocsigen_lib.String.sep '=') (Ocsigen_lib.String.split ';' b) ) 108 | with _ -> parse_name s, [] 109 | 110 | let parse_list_with_extensions parse_name s = 111 | List.map (Ocsigen_lib.String.split ',') s 112 | |> List.flatten 113 | |> List.map (parse_extensions parse_name) 114 | 115 | let parse s = 116 | try 117 | let l = parse_list_with_extensions Mime_type.parse s in 118 | let change_quality (a, l) = 119 | try 120 | let q, ll = Ocsigen_lib.List.assoc_remove "q" l in 121 | a, Some (float_of_string q), ll 122 | with _ -> a, None, l 123 | in 124 | List.map change_quality l 125 | with _ -> [] 126 | end 127 | 128 | module Accept_encoding = struct 129 | type t = (string option * float option) list 130 | 131 | let parse s = 132 | try 133 | List.map (Ocsigen_lib.String.split ',') s 134 | |> List.flatten 135 | |> List.map (parse_quality parse_star) 136 | with _ -> [] 137 | end 138 | 139 | module Accept_language = struct 140 | type t = (string * float option) list 141 | 142 | let parse s = 143 | try 144 | List.map (Ocsigen_lib.String.split ',') s 145 | |> List.flatten 146 | |> List.map (parse_quality (fun x -> x)) 147 | with _ -> [] 148 | end 149 | 150 | module Content_type = struct 151 | let choose accept default alt = 152 | try 153 | List.find 154 | (fun content_type -> 155 | let f = function 156 | | (Some a, Some b), _, _ -> a ^ "/" ^ b = content_type 157 | | _ -> false 158 | in 159 | List.exists f accept) 160 | (default :: alt) 161 | with Not_found -> default 162 | end 163 | -------------------------------------------------------------------------------- /src/http/ocsigen_header.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | type t = Cohttp.Header.t 20 | 21 | val of_option : t option -> t 22 | 23 | module Name : sig 24 | type t 25 | 26 | val to_string : t -> string 27 | val of_string : string -> t 28 | val accept : t 29 | val accept_charset : t 30 | val accept_encoding : t 31 | val accept_language : t 32 | val accept_ranges : t 33 | val authorization : t 34 | val cache_control : t 35 | val connection : t 36 | val content_disposition : t 37 | val content_encoding : t 38 | val content_length : t 39 | val content_type : t 40 | val content_range : t 41 | val cookie : t 42 | val date : t 43 | val etag : t 44 | val expect : t 45 | val expires : t 46 | val host : t 47 | val if_match : t 48 | val if_modified_since : t 49 | val if_none_match : t 50 | val if_unmodified_since : t 51 | val if_range : t 52 | val last_modified : t 53 | val location : t 54 | val pragma : t 55 | val server : t 56 | val set_cookie : t 57 | val status : t 58 | val transfer_encoding : t 59 | val user_agent : t 60 | val referer : t 61 | val range : t 62 | val x_forwarded_for : t 63 | val x_forwarded_proto : t 64 | val origin : t 65 | val access_control_request_method : t 66 | val access_control_request_headers : t 67 | val access_control_allow_origin : t 68 | val access_control_allow_credentials : t 69 | val access_control_expose_headers : t 70 | val access_control_max_age : t 71 | val access_control_allow_methods : t 72 | val access_control_allow_headers : t 73 | end 74 | 75 | module Mime_type : sig 76 | type t = string option * string option 77 | 78 | val parse : string -> t 79 | end 80 | 81 | module Accept : sig 82 | type t = (Mime_type.t * float option * (string * string) list) list 83 | 84 | val parse : string list -> t 85 | end 86 | 87 | module Accept_encoding : sig 88 | type t = (string option * float option) list 89 | 90 | val parse : string list -> t 91 | end 92 | 93 | module Accept_language : sig 94 | type t = (string * float option) list 95 | 96 | val parse : string list -> t 97 | end 98 | 99 | module Content_type : sig 100 | val choose : Accept.t -> string -> string list -> string 101 | end 102 | -------------------------------------------------------------------------------- /src/ocsigenserver.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let alt_msg = 3 | "Alternate config file (default " ^ Ocsigen_config.get_config_file () ^ ")" 4 | and silent_msg = "Silent mode (error messages in errors.log only)" 5 | and pid_msg = "Specify a file where to write the PIDs of servers" 6 | and daemon_msg = "Daemon mode (detach the process)" 7 | and verbose_msg = "Verbose mode" 8 | and veryverbose_msg = "Very verbose mode (info)" 9 | and debug_msg = "Extremely verbose mode (debug)" 10 | and version_msg = "Display version number and exit" in 11 | try 12 | Arg.parse_argv Sys.argv 13 | [ "-c", Arg.String Ocsigen_config.set_configfile, alt_msg 14 | ; "--config", Arg.String Ocsigen_config.set_configfile, alt_msg 15 | ; "-s", Arg.Unit Ocsigen_config.set_silent, silent_msg 16 | ; "--silent", Arg.Unit Ocsigen_config.set_silent, silent_msg 17 | ; "-p", Arg.String Ocsigen_config.set_pidfile, pid_msg 18 | ; "--pidfile", Arg.String Ocsigen_config.set_pidfile, pid_msg 19 | ; "-v", Arg.Unit Ocsigen_config.set_verbose, verbose_msg 20 | ; "--verbose", Arg.Unit Ocsigen_config.set_verbose, verbose_msg 21 | ; "-vv", Arg.Unit Ocsigen_config.set_veryverbose, veryverbose_msg 22 | ; ( "--veryverbose" 23 | , Arg.Unit Ocsigen_config.set_veryverbose 24 | , veryverbose_msg ) 25 | ; "-vvv", Arg.Unit Ocsigen_config.set_debug, debug_msg 26 | ; "--debug", Arg.Unit Ocsigen_config.set_debug, debug_msg 27 | ; "-d", Arg.Unit Ocsigen_config.set_daemon, daemon_msg 28 | ; "--daemon", Arg.Unit Ocsigen_config.set_daemon, daemon_msg 29 | ; "--version", Arg.Unit Ocsigen_config.display_version, version_msg ] 30 | (fun _ -> ()) 31 | "usage: ocsigenserver [-c configfile]" 32 | with Arg.Help s -> print_endline s; exit 0 33 | 34 | let () = Ocsigen_server.exec (Ocsigen_parseconfig.parse_config ()) 35 | -------------------------------------------------------------------------------- /src/server/Makefile: -------------------------------------------------------------------------------- 1 | include ../../Makefile.options 2 | include ../../Makefile.config 3 | 4 | .PHONY: default 5 | default: build 6 | 7 | .PHONY: build 8 | build: 9 | dune build 10 | 11 | ## Toplevel 12 | 13 | SERVERLIBS := ${BLD}/baselib/ocsigen_lib_base.cma \ 14 | ${BLD}/baselib/baselib.cma \ 15 | ${BLD}/baselib/polytables/polytables.cma \ 16 | ${BLD}/http/http.cma \ 17 | ${BLD}/http/ocsigen_cookie_map.cma \ 18 | ${BLD}/server/ocsigenserver.cma 19 | 20 | top: servertop 21 | OCAMLPATH=${SRC}/src/files/:${OCAMLPATH} ${RLWRAP} ./servertop 22 | 23 | servertop: build 24 | OCAMLPATH=${SRC}/src/files/:${OCAMLPATH} ${OCAMLFIND} ocamlmktop \ 25 | -o $@ -linkall -linkpkg ${THREAD} ${LIBS} ${SERVERLIBS} 26 | 27 | ## Clean up 28 | 29 | clean: 30 | dune clean 31 | 32 | distclean: clean 33 | -rm -f *~ \#* .\#* 34 | -rm -f servertop 35 | -------------------------------------------------------------------------------- /src/server/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ocsigenserver) 3 | (public_name ocsigenserver) 4 | (wrapped false) 5 | (libraries 6 | xml-light 7 | cohttp-lwt-unix 8 | polytables 9 | ocsigen_cookie_map 10 | baselib 11 | ocsigen_http 12 | logs 13 | logs-syslog.unix 14 | syslog-message)) 15 | -------------------------------------------------------------------------------- /src/server/ocsigen_cohttp.mli: -------------------------------------------------------------------------------- 1 | val section : Logs.src 2 | 3 | exception Ocsigen_http_error of Ocsigen_cookie_map.t * Cohttp.Code.status 4 | 5 | exception 6 | Ext_http_error of Cohttp.Code.status * string option * Cohttp.Header.t option 7 | (** Exception raised by exceptions to describe an HTTP error. It is 8 | possible to pass the code of the error, an optional comment, and 9 | optionally some headers. *) 10 | 11 | exception Ocsigen_is_dir of (Ocsigen_request.t -> Uri.t) 12 | (** compute a redirection if path links to a directory *) 13 | 14 | val get_number_of_connected : unit -> int 15 | (** accessor to get number of client (used by eliom monitoring) *) 16 | 17 | val shutdown : float option -> unit 18 | (** Shutdown main loop of server *) 19 | 20 | val service : 21 | ?ssl:string * string * (bool -> string) option 22 | -> address:Ocsigen_config.socket_type 23 | -> port:int 24 | -> connector:(Ocsigen_request.t -> Ocsigen_response.t Lwt.t) 25 | -> unit 26 | -> unit Lwt.t 27 | (** initialize a main loop of http server *) 28 | -------------------------------------------------------------------------------- /src/server/ocsigen_command.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module ocsigen_extensions.ml 4 | * Copyright (C) 2015 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | exception Unknown_command 22 | 23 | let register_command_function, get_command_function = 24 | let command_function = ref (fun ?prefix:_ _ _ -> Lwt.fail Unknown_command) in 25 | ( (fun ?prefix f -> 26 | let prefix' = prefix in 27 | let old_command_function = !command_function in 28 | command_function := 29 | fun ?prefix s c -> 30 | Lwt.catch 31 | (fun () -> old_command_function ?prefix s c) 32 | (function 33 | | Unknown_command -> 34 | if prefix = prefix' then f s c else Lwt.fail Unknown_command 35 | | e -> Lwt.fail e)) 36 | , fun () -> !command_function ) 37 | 38 | let () = 39 | register_command_function ~prefix:"logs" 40 | (Ocsigen_messages.command_f Unknown_command) 41 | -------------------------------------------------------------------------------- /src/server/ocsigen_command.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module ocsigen_extensions.ml 4 | * Copyright (C) 2015 Vincent Balat 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Extending server commands *) 22 | 23 | exception Unknown_command 24 | 25 | val register_command_function : 26 | ?prefix:string 27 | -> (string -> string list -> unit Lwt.t) 28 | -> unit 29 | (** Use a prefix for all your commands when you want to create 30 | extension-specific commands. 31 | For example if the prefix is "myextension" and the commande "blah", 32 | the actual command to be written by the user is "myextension:blah". 33 | Give as parameter the function that will parse the command and do an action. 34 | Its first parameter is the full command as a string. 35 | The second one is the command without prefix, split by word. 36 | It must raise [ocsigen_extensions.Unknown_command] if it does 37 | not recognize the command. 38 | *) 39 | 40 | (**/**) 41 | 42 | val get_command_function : 43 | unit 44 | -> ?prefix:string 45 | -> string 46 | -> string list 47 | -> unit Lwt.t 48 | -------------------------------------------------------------------------------- /src/server/ocsigen_config.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2005-2017 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | include Ocsigen_config_static 20 | 21 | exception Config_file_error of string 22 | 23 | type ssl_info = 24 | { ssl_certificate : string option 25 | ; ssl_privatekey : string option 26 | ; ssl_ciphers : string option 27 | ; ssl_dhfile : string option 28 | ; ssl_curve : string option } 29 | 30 | module Socket_type = struct 31 | type t = 32 | [`All | `IPv4 of Unix.inet_addr | `IPv6 of Unix.inet_addr | `Unix of string] 33 | 34 | let to_string = function 35 | | `All -> Unix.string_of_inet_addr Unix.inet_addr_any 36 | | `IPv4 u -> Unix.string_of_inet_addr u 37 | | `IPv6 u -> Unix.string_of_inet_addr u 38 | | `Unix s -> s 39 | end 40 | 41 | type socket_type = Socket_type.t 42 | 43 | (* General config *) 44 | let verbose = ref false 45 | let silent = ref false 46 | let daemon = ref false 47 | let veryverbose = ref false 48 | let debug = ref false 49 | let version_number = "0000000000000000" 50 | let pidfile = ref (None : string option) 51 | let server_name = "Ocsigen" 52 | let full_server_name = server_name ^ "/" ^ version_number 53 | let native_ext = if is_native then ".exe" else ".bc" 54 | let (uploaddir : string option ref) = ref None 55 | let syslog_facility = ref None 56 | let minthreads = ref 10 57 | let maxthreads = ref 30 58 | let max_number_of_connections = ref 350 59 | let silent_client_timeout = ref 30 (* without speaking during sending frame *) 60 | let silent_server_timeout = ref 30 (* without speaking during sending frame *) 61 | let filebuffersize = ref 8192 62 | let maxrequestbodysize = ref (Some (Int64.of_int 8000000)) 63 | let maxrequestbodysizeinmemory = ref 8192 64 | let maxuploadfilesize = ref (Some (Int64.of_int 2000000)) 65 | let defaultcharset = ref (None : string option) 66 | let debugmode = ref false 67 | let disablepartialrequests = ref false 68 | let usedefaulthostname = ref false 69 | let respectpipeline = ref false 70 | let maxretries = ref 10 71 | let shutdowntimeout = ref (Some 10.) 72 | let ssl_info = ref None 73 | let ports = ref [] 74 | let ssl_ports = ref [] 75 | let set_uploaddir u = uploaddir := u 76 | let set_logdir s = logdir := Some s 77 | 78 | let set_syslog_facility f = 79 | syslog_facility := f; 80 | logdir := None 81 | 82 | let set_configfile s = config_file := s 83 | let set_pidfile s = pidfile := Some s 84 | let set_mimefile s = mimefile := s 85 | let () = Logs.set_level ~all:true (Some Logs.Warning) 86 | (* without --verbose *) 87 | 88 | let set_verbose () = 89 | verbose := true; 90 | Logs.set_level ~all:true None 91 | 92 | let set_silent () = silent := true 93 | 94 | let set_daemon () = 95 | set_silent (); 96 | daemon := true 97 | 98 | let set_veryverbose () = 99 | verbose := true; 100 | veryverbose := true; 101 | Logs.set_level ~all:true (Some Logs.Info) 102 | 103 | let set_debug () = 104 | verbose := true; 105 | veryverbose := true; 106 | debug := true; 107 | Logs.set_level ~all:true (Some Logs.Debug) 108 | 109 | let set_minthreads i = minthreads := i 110 | let set_maxthreads i = maxthreads := i 111 | let set_max_number_of_connections i = max_number_of_connections := i 112 | let set_client_timeout i = silent_client_timeout := i 113 | let set_server_timeout i = silent_server_timeout := i 114 | 115 | (* let set_keepalive_timeout i = keepalive_timeout := i 116 | let set_keepopen_timeout i = keepopen_timeout := i *) 117 | let set_filebuffersize i = filebuffersize := i 118 | let set_maxuploadfilesize i = maxuploadfilesize := i 119 | let set_maxrequestbodysize i = maxrequestbodysize := i 120 | let set_maxrequestbodysizeinmemory i = maxrequestbodysizeinmemory := i 121 | let set_default_charset o = defaultcharset := o 122 | let set_datadir o = datadir := o 123 | let set_bindir o = bindir := o 124 | let set_extdir o = extdir := o 125 | let set_command_pipe s = command_pipe := s 126 | let set_debugmode s = debugmode := s 127 | let set_disablepartialrequests s = disablepartialrequests := s 128 | let set_usedefaulthostname s = usedefaulthostname := s 129 | let set_respect_pipeline () = respectpipeline := true 130 | let set_maxretries i = maxretries := i 131 | let set_shutdown_timeout s = shutdowntimeout := s 132 | let set_ssl_info i = ssl_info := i 133 | let set_ports l = ports := l 134 | let set_ssl_ports l = ssl_ports := l 135 | let get_uploaddir () = !uploaddir 136 | 137 | let get_logdir () = 138 | match !logdir with 139 | | Some s -> s 140 | | None -> raise (Config_file_error "Log directory requested, but not set") 141 | 142 | let get_syslog_facility () = !syslog_facility 143 | let get_config_file () = !config_file 144 | let get_pidfile () = !pidfile 145 | let get_mimefile () = !mimefile 146 | let get_verbose () = !verbose 147 | let get_silent () = !silent 148 | let get_daemon () = !daemon 149 | let get_veryverbose () = !veryverbose 150 | let get_debug () = !debug 151 | let get_minthreads () = !minthreads 152 | let get_maxthreads () = !maxthreads 153 | let get_max_number_of_connections () = !max_number_of_connections 154 | let get_client_timeout () = !silent_client_timeout 155 | let get_server_timeout () = !silent_server_timeout 156 | let get_filebuffersize () = !filebuffersize 157 | let get_maxuploadfilesize () = !maxuploadfilesize 158 | let get_maxrequestbodysize () = !maxrequestbodysize 159 | let get_maxrequestbodysizeinmemory () = !maxrequestbodysizeinmemory 160 | let get_default_charset () = !defaultcharset 161 | let get_datadir () = !datadir 162 | let get_bindir () = !bindir 163 | let get_extdir () = !extdir 164 | let get_command_pipe () = !command_pipe 165 | let get_debugmode () = !debugmode 166 | let get_disablepartialrequests () = !disablepartialrequests 167 | let get_usedefaulthostname () = !usedefaulthostname 168 | let get_respect_pipeline () = !respectpipeline 169 | let get_maxretries () = !maxretries 170 | let get_shutdown_timeout () = !shutdowntimeout 171 | let get_ssl_info () = !ssl_info 172 | let get_ports () = !ports 173 | let get_ssl_ports () = !ssl_ports 174 | let get_default_port () = match !ports with (_, p) :: _ -> p | [] -> 80 175 | 176 | let get_default_sslport () = 177 | match !ssl_ports with (_, p) :: _ -> p | [] -> 443 178 | 179 | let display_version () = 180 | print_string version_number; 181 | print_newline (); 182 | exit 0 183 | 184 | let has_config_file = ref false 185 | let has_configuration_file () = !has_config_file 186 | -------------------------------------------------------------------------------- /src/server/ocsigen_config.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2005 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | (** Configuring Ocsigen server *) 20 | 21 | open Ocsigen_lib 22 | 23 | type ssl_info = 24 | { ssl_certificate : string option 25 | ; ssl_privatekey : string option 26 | ; ssl_ciphers : string option 27 | ; ssl_dhfile : string option 28 | ; ssl_curve : string option } 29 | 30 | module Socket_type : sig 31 | type t = 32 | [`All | `IPv4 of Unix.inet_addr | `IPv6 of Unix.inet_addr | `Unix of string] 33 | 34 | val to_string : t -> string 35 | end 36 | 37 | type socket_type = Socket_type.t 38 | 39 | exception Config_file_error of string 40 | 41 | val server_name : string 42 | val full_server_name : string 43 | val version_number : string 44 | val is_native : bool 45 | val native_ext : string 46 | val builtin_packages : String.Set.t 47 | val set_logdir : string -> unit 48 | val set_syslog_facility : Syslog_message.facility option -> unit 49 | val set_configfile : string -> unit 50 | val set_pidfile : string -> unit 51 | val set_mimefile : string -> unit 52 | val set_verbose : unit -> unit 53 | val set_silent : unit -> unit 54 | val set_daemon : unit -> unit 55 | val set_veryverbose : unit -> unit 56 | val set_debug : unit -> unit 57 | val set_minthreads : int -> unit 58 | val set_maxthreads : int -> unit 59 | val set_max_number_of_connections : int -> unit 60 | val set_client_timeout : int -> unit 61 | val set_server_timeout : int -> unit 62 | 63 | (* val set_keepalive_timeout : int -> unit 64 | val set_keepopen_timeout : int -> unit *) 65 | val set_filebuffersize : int -> unit 66 | val set_maxrequestbodysize : int64 option -> unit 67 | val set_maxrequestbodysizeinmemory : int -> unit 68 | val set_default_charset : string option -> unit 69 | val set_datadir : string -> unit 70 | val set_bindir : string -> unit 71 | val set_extdir : string -> unit 72 | val set_command_pipe : string -> unit 73 | val set_debugmode : bool -> unit 74 | val set_disablepartialrequests : bool -> unit 75 | val set_usedefaulthostname : bool -> unit 76 | val set_respect_pipeline : unit -> unit 77 | val set_maxretries : int -> unit 78 | val set_shutdown_timeout : float option -> unit 79 | val set_ssl_info : ssl_info option -> unit 80 | val set_ports : (socket_type * int) list -> unit 81 | val set_ssl_ports : (socket_type * int) list -> unit 82 | val get_logdir : unit -> string 83 | val get_syslog_facility : unit -> Syslog_message.facility option 84 | val get_config_file : unit -> string 85 | val get_pidfile : unit -> string option 86 | val get_mimefile : unit -> string 87 | val get_verbose : unit -> bool 88 | val get_silent : unit -> bool 89 | val get_daemon : unit -> bool 90 | val get_veryverbose : unit -> bool 91 | val get_debug : unit -> bool 92 | val get_minthreads : unit -> int 93 | val get_maxthreads : unit -> int 94 | val get_max_number_of_connections : unit -> int 95 | val get_client_timeout : unit -> int 96 | val get_server_timeout : unit -> int 97 | 98 | val has_configuration_file : unit -> bool 99 | (** returns true if Ocsigen Server is running with a configuration file, *) 100 | 101 | (*val get_keepalive_timeout : unit -> int 102 | val get_keepopen_timeout : unit -> int*) 103 | val get_filebuffersize : unit -> int 104 | val get_maxrequestbodysize : unit -> int64 option 105 | val get_maxrequestbodysizeinmemory : unit -> int 106 | val get_default_charset : unit -> string option 107 | val get_datadir : unit -> string 108 | val get_bindir : unit -> string 109 | val get_extdir : unit -> string 110 | val get_command_pipe : unit -> string 111 | val get_debugmode : unit -> bool 112 | val get_disablepartialrequests : unit -> bool 113 | val get_usedefaulthostname : unit -> bool 114 | val get_respect_pipeline : unit -> bool 115 | val get_default_port : unit -> int 116 | val get_default_sslport : unit -> int 117 | val get_maxretries : unit -> int 118 | val get_shutdown_timeout : unit -> float option 119 | val get_ssl_info : unit -> ssl_info option 120 | val get_ports : unit -> (socket_type * int) list 121 | val get_ssl_ports : unit -> (socket_type * int) list 122 | val display_version : unit -> 'a 123 | 124 | (**/**) 125 | 126 | (* Global setting for upload directory. This can be overwritten 127 | on a per-site basis. Thus, use only the value inside the [ri.request_config] 128 | field of a request (which can be changed by the extension 129 | [Extendconfiguration]) *) 130 | val set_uploaddir : string option -> unit 131 | val get_uploaddir : unit -> string option 132 | 133 | (* Same thing for upload size *) 134 | val set_maxuploadfilesize : int64 option -> unit 135 | val get_maxuploadfilesize : unit -> int64 option 136 | val has_config_file : bool ref 137 | -------------------------------------------------------------------------------- /src/server/ocsigen_local_files.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2009 Boris Yakobowski 4 | * 5 | * This program is free software; you can redistribute it and/or modify 6 | * it under the terms of the GNU Lesser General Public License as published by 7 | * the Free Software Foundation, with linking exception; 8 | * either version 2.1 of the License, or (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU Lesser General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU Lesser General Public License 16 | * along with this program; if not, write to the Free Software 17 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 18 | *) 19 | 20 | val section : Logs.src 21 | 22 | exception Failed_404 23 | (** The requested file does not exists *) 24 | 25 | exception Failed_403 26 | (** The requested file cannot be served: does not exists, not 27 | enough permissions ... *) 28 | 29 | exception NotReadableDirectory 30 | (** The file is a directory which we should not display *) 31 | 32 | (* 33 | (** Default options: 34 | - never follow symlinks 35 | - use "index.html" as default index 36 | - do not list the content of directories 37 | *) 38 | val default_options : options 39 | *) 40 | 41 | (** Local file corresponding to a request. The string argument 42 | represents the real file or directory to serve, eg. foo/index.html 43 | instead of foo *) 44 | type resolved = RFile of string | RDir of string 45 | 46 | val resolve : 47 | ?no_check_for:string 48 | -> request:Ocsigen_extensions.request 49 | -> filename:string 50 | -> unit 51 | -> resolved 52 | (** Finds [filename] in the filesystem, with a possible redirection 53 | if it is a directory. Takes into account the fact that [filename] 54 | does not exists, is a symlink or is a directory, and raises 55 | Failed_404 or Failed_403 accordingly. 56 | 57 | - we return ["filename/index.html"] if [filename] corresponds to 58 | a directory, ["filename/index.html"] is valid, and ["index.html"] 59 | is one possible index (trying all possible indexes in order) 60 | - we raise [Failed_404] if [filename] corresponds to a directory, 61 | no index exists and [list_dir_content] is false. 62 | Warning: this behaviour is not the same as Apache's but it corresponds 63 | to a missing service in Eliom (answers 404). This also allows to have 64 | an Eliom service after a "forbidden" directory 65 | - we raise [Failed_403] if [filename] is a symlink that must 66 | not be followed 67 | - raises [Failed_404] if [filename] does not exist, or is a special file 68 | - otherwise returns [filename] 69 | 70 | [no_check_for] is supposed to be a prefix of [filename] ; 71 | directories above [no_check_for] are not checked for symlinks *) 72 | -------------------------------------------------------------------------------- /src/server/ocsigen_messages.ml: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2005 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | (** Writing messages in the logs *) 20 | 21 | let access_file = "access.log" 22 | let warning_file = "warnings.log" 23 | let error_file = "errors.log" 24 | let access_sect = Logs.Src.create "ocsigen:access" 25 | let full_path f = Filename.concat (Ocsigen_config.get_logdir ()) f 26 | let error_log_path () = full_path error_file 27 | 28 | (* This is the date format inherited from [Lwt_log]. *) 29 | let pp_date ppf = 30 | let time = Unix.gettimeofday () in 31 | let tm = Unix.localtime time in 32 | let month_string = 33 | match tm.Unix.tm_mon with 34 | | 0 -> "Jan" 35 | | 1 -> "Feb" 36 | | 2 -> "Mar" 37 | | 3 -> "Apr" 38 | | 4 -> "May" 39 | | 5 -> "Jun" 40 | | 6 -> "Jul" 41 | | 7 -> "Aug" 42 | | 8 -> "Sep" 43 | | 9 -> "Oct" 44 | | 10 -> "Nov" 45 | | 11 -> "Dec" 46 | | _ -> "" 47 | in 48 | Format.fprintf ppf "%s %2d %02d:%02d:%02d" month_string tm.Unix.tm_mday 49 | tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec 50 | 51 | let make_reporter out_channel = 52 | let ppf = Format.formatter_of_out_channel out_channel in 53 | let report src level ~over k msgf = 54 | let k _ = over (); k () in 55 | msgf @@ fun ?header ?tags:_ fmt -> 56 | Format.kfprintf k ppf 57 | ("%t: %s: %a @[" ^^ fmt ^^ "@]@.") 58 | pp_date (Logs.Src.name src) Logs.pp_header (level, header) 59 | in 60 | {Logs.report} 61 | 62 | let stderr = make_reporter stderr 63 | let stdout = make_reporter stdout 64 | let close_loggers = ref [] 65 | 66 | let open_files () = 67 | (* CHECK: we are closing asynchronously! That should be ok, though. *) 68 | List.iter (fun close -> close ()) !close_loggers; 69 | close_loggers := []; 70 | match Ocsigen_config.get_syslog_facility () with 71 | | Some facility -> 72 | (* log to syslog *) 73 | (* Syslog reporter cannot be closed *) 74 | let syslog = 75 | match Logs_syslog_unix.unix_reporter ~facility () with 76 | | Ok r -> r 77 | | Error msg -> failwith msg 78 | in 79 | Logs.set_reporter 80 | (let broadcast_reporters = [syslog; stderr] in 81 | { Logs.report = 82 | (fun src level ~over k msgf -> 83 | List.fold_left 84 | (fun k r () -> r.Logs.report src level ~over k msgf) 85 | k broadcast_reporters ()) }); 86 | Lwt.return () 87 | | None -> 88 | (* log to files *) 89 | let open_channel path = 90 | let path = full_path path in 91 | try 92 | let channel = 93 | open_out_gen 94 | [Open_append; Open_wronly; Open_creat; Open_text] 95 | 0o640 path 96 | in 97 | channel, fun () -> close_out_noerr channel 98 | with 99 | | Unix.Unix_error (error, _, _) -> 100 | raise 101 | (Ocsigen_config.Config_file_error 102 | (Printf.sprintf "can't open log file %s: %s" path 103 | (Unix.error_message error))) 104 | | exn -> raise exn 105 | in 106 | let open_log path = 107 | let channel, close = open_channel path in 108 | make_reporter channel, close 109 | in 110 | let acc = open_log access_file in 111 | let war = open_log warning_file in 112 | let err = open_log error_file in 113 | close_loggers := [snd acc; snd war; snd err]; 114 | Logs.set_reporter 115 | (let broadcast_reporters = 116 | [ { Logs.report = 117 | (fun src _level ~over k msgf -> 118 | let r = 119 | if Logs.Src.equal src access_sect 120 | then fst acc 121 | else Logs.nop_reporter 122 | in 123 | r.Logs.report src Error ~over k msgf) } 124 | ; (let dispatch_f = 125 | fun _sect lev -> 126 | match lev with 127 | | Logs.Error -> fst err 128 | | Logs.Warning -> fst war 129 | | _ -> Logs.nop_reporter 130 | in 131 | { Logs.report = 132 | (fun src level ~over k msgf -> 133 | (dispatch_f src level).Logs.report src level ~over k msgf) 134 | }) 135 | ; (let dispatch_f = 136 | fun _sect lev -> 137 | if Ocsigen_config.get_silent () 138 | then Logs.nop_reporter 139 | else 140 | match lev with 141 | | Logs.Warning | Logs.Error -> stderr 142 | | _ -> stdout 143 | in 144 | { Logs.report = 145 | (fun src level ~over k msgf -> 146 | (dispatch_f src level).Logs.report src level ~over k msgf) 147 | }) ] 148 | in 149 | { Logs.report = 150 | (fun src level ~over k msgf -> 151 | List.fold_left 152 | (fun k r () -> r.Logs.report src level ~over k msgf) 153 | k broadcast_reporters ()) }); 154 | Lwt.return () 155 | 156 | (****) 157 | 158 | let accesslog s = Logs.app ~src:access_sect (fun fmt -> fmt "%s" s) 159 | let errlog ?section s = Logs.err ?src:section (fun fmt -> fmt "%s" s) 160 | let warning ?section s = Logs.warn ?src:section (fun fmt -> fmt "%s" s) 161 | 162 | let unexpected_exception e s = 163 | Logs.warn (fun fmt -> 164 | fmt ("Unexpected exception in %s" ^^ "@\n%s") s (Printexc.to_string e)) 165 | 166 | (****) 167 | 168 | let console = 169 | if not (Ocsigen_config.get_silent ()) 170 | then fun s -> print_endline (s ()) 171 | else fun _s -> () 172 | 173 | let level_of_string = function 174 | | "debug" -> Some Logs.Debug 175 | | "info" -> Some Logs.Info 176 | | "notice" -> Some Logs.App 177 | | "warning" -> Some Logs.Warning 178 | | "error" -> Some Logs.Error 179 | | "fatal" -> Some Logs.Error 180 | | _ -> None 181 | 182 | let command_f exc _ = function 183 | | [sect_name] -> 184 | (* Lwt_log.Section.make : 185 | if a section with the same name 186 | already exists, it is returned. *) 187 | let sect = Logs.Src.create sect_name in 188 | Logs.Src.set_level sect None; 189 | Lwt.return_unit 190 | | [sect_name; level_name] -> 191 | (* Lwt_log.Section.make : 192 | if a section with the same name 193 | already exists, it is returned. *) 194 | let sect = Logs.Src.create sect_name in 195 | (match level_of_string (String.lowercase_ascii level_name) with 196 | | None -> Logs.Src.set_level sect None 197 | | Some l -> Logs.Src.set_level sect (Some l)); 198 | Lwt.return () 199 | | _ -> Lwt.fail exc 200 | -------------------------------------------------------------------------------- /src/server/ocsigen_messages.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * Copyright (C) 2005 Vincent Balat 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | (** Writing messages in the logs *) 20 | 21 | val access_sect : Logs.src 22 | 23 | val accesslog : string -> unit 24 | (** Write a message in access.log *) 25 | 26 | val errlog : ?section:Logs.src -> string -> unit 27 | (** Write a message in errors.log *) 28 | 29 | val warning : ?section:Logs.src -> string -> unit 30 | (** Write a message in warnings.log *) 31 | 32 | val console : (unit -> string) -> unit 33 | (** Write a message in the console (if not called in silent mode) *) 34 | 35 | val unexpected_exception : exn -> string -> unit 36 | (** Use that function for all impossible cases in exception handlers 37 | ([try ... with ... | e -> unexpected_exception ...] or [Lwt.catch ...]). 38 | A message will be written in [warnings.log]. 39 | Put something in the string to help locating the problem (usually the name 40 | of the function where is has been called). 41 | *) 42 | 43 | val error_log_path : unit -> string 44 | (** Path to the error log file *) 45 | 46 | (**/**) 47 | 48 | val open_files : unit -> unit Lwt.t 49 | val command_f : exn -> string -> string list -> unit Lwt.t 50 | -------------------------------------------------------------------------------- /src/server/ocsigen_multipart.mli: -------------------------------------------------------------------------------- 1 | val section : Logs.src 2 | 3 | val scan_multipart_body_from_stream : 4 | ?max_size:Int64.t 5 | -> boundary:string 6 | -> create:((string * string) list -> 'a) 7 | -> add:('a -> string -> unit Lwt.t) 8 | -> stop:(int64 -> 'a -> 'b Lwt.t) 9 | -> string Ocsigen_stream.stream 10 | -> unit Lwt.t 11 | 12 | type content_type = (string * string) * (string * string) list 13 | 14 | type file_info = 15 | { tmp_filename : string 16 | ; filesize : int64 17 | ; raw_original_filename : string 18 | ; file_content_type : content_type option } 19 | 20 | type post_data = (string * string) list * (string * file_info) list 21 | 22 | val post_params : 23 | content_type:content_type 24 | -> Cohttp_lwt.Body.t 25 | -> (string option -> Int64.t option -> post_data Lwt.t) option 26 | 27 | val parse_content_type : string -> content_type option 28 | -------------------------------------------------------------------------------- /src/server/ocsigen_parseconfig.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Module ocsigen_parseconfig.ml 4 | * Copyright (C) 2005 Vincent Balat, Nataliya Guts 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Config file parsing. See also module 22 | {! Ocsigen_extensions.​Configuration } *) 23 | 24 | (**/**) 25 | 26 | val section : Logs.src 27 | 28 | val parse_size_tag : string -> string -> int64 option 29 | (** [parse_size_tag tag s] parses a size. 30 | 31 | The size can be either "infinity" or use SI or binary units, e.g., 32 | 10 10B 10o 10ko 10kB 10kiB 10MiB 10TB ... . 33 | 34 | In case of error, raises [Ocsigen_config.Config_file_error m] 35 | where [m] is an error message explaining that a size was expected 36 | in tag []. *) 37 | 38 | val first_pass : Xml.xml list -> unit 39 | (** Extracts (and stores via Ocsigen_config) the following information: 40 | {ul 41 | {- user to execute OcsigenServer (ex: www-data) } 42 | {- group to execute OcsigenServer (ex: www-data) } 43 | {- SSL key, SSL certificate, SSL ciphers list, 44 | SSL DH file, SSL EC curve } 45 | {- list of HTTP port to listen on (ex: 80) } 46 | {- list of HTTPS port to listen on (ex: 443) } 47 | {- minimum and maximum number of threads } 48 | } 49 | To be called early by [Ocsigen_server]. 50 | *) 51 | 52 | val later_pass : Xml.xml list -> unit 53 | 54 | (**/**) 55 | 56 | val parse_config : ?file:string -> unit -> Xml.xml list list 57 | (** Returns the config file. Use this if you want to read a config file from 58 | your own executable. See {!Ocsigen_server.exec}.*) 59 | -------------------------------------------------------------------------------- /src/server/ocsigen_request.mli: -------------------------------------------------------------------------------- 1 | type t 2 | type content_type = (string * string) * (string * string) list 3 | 4 | type file_info = Ocsigen_multipart.file_info = 5 | { tmp_filename : string 6 | ; filesize : int64 7 | ; raw_original_filename : string 8 | ; file_content_type : content_type option } 9 | 10 | type post_data = (string * string) list * (string * file_info) list 11 | 12 | val make : 13 | ?forward_ip:string list 14 | -> ?sub_path:string 15 | -> ?original_full_path:string 16 | -> ?request_cache:Polytables.t 17 | -> ?cookies_override:string Ocsigen_cookie_map.Map_inner.t 18 | -> address:Ocsigen_config.Socket_type.t 19 | -> port:int 20 | -> ssl:bool 21 | -> filenames:string list ref 22 | -> sockaddr:Lwt_unix.sockaddr 23 | -> body:Cohttp_lwt.Body.t 24 | -> connection_closed:unit Lwt.t 25 | -> Cohttp.Request.t 26 | -> t 27 | 28 | val update : 29 | ?ssl:bool 30 | -> ?forward_ip:string list 31 | -> ?remote_ip:string 32 | -> ?sub_path:string 33 | -> ?meth:Cohttp.Code.meth 34 | -> ?get_params_flat:(string * string) list 35 | -> ?post_data:post_data option 36 | -> ?cookies_override:string Ocsigen_cookie_map.Map_inner.t 37 | -> ?full_rewrite:bool 38 | -> ?uri:Uri.t 39 | -> t 40 | -> t 41 | 42 | val to_cohttp : t -> Cohttp.Request.t 43 | val uri : t -> Uri.t 44 | val body : t -> Cohttp_lwt.Body.t 45 | val address : t -> Ocsigen_config.Socket_type.t 46 | val host : t -> string option 47 | val meth : t -> Cohttp.Code.meth 48 | val port : t -> int 49 | val ssl : t -> bool 50 | val version : t -> Cohttp.Code.version 51 | val query : t -> string option 52 | val get_params : t -> (string * string list) list 53 | val get_params_flat : t -> (string * string) list 54 | val path : t -> string list 55 | val path_string : t -> string 56 | val sub_path : t -> string list 57 | val sub_path_string : t -> string 58 | val original_full_path : t -> string list 59 | val original_full_path_string : t -> string 60 | val header : t -> Ocsigen_header.Name.t -> string option 61 | val header_multi : t -> Ocsigen_header.Name.t -> string list 62 | val add_header : t -> Ocsigen_header.Name.t -> string -> t 63 | val cookies : t -> string Ocsigen_cookie_map.Map_inner.t 64 | 65 | val files : 66 | t 67 | -> string option 68 | -> Int64.t option 69 | -> (string * file_info) list Lwt.t option 70 | 71 | val post_params : 72 | t 73 | -> string option 74 | -> Int64.t option 75 | -> (string * string) list Lwt.t option 76 | 77 | val remote_ip : t -> string 78 | val remote_ip_parsed : t -> [`Ip of Ipaddr.t | `Unix of string] 79 | val forward_ip : t -> string list 80 | val content_type : t -> content_type option 81 | val request_cache : t -> Polytables.t 82 | val tries : t -> int 83 | val incr_tries : t -> unit 84 | val connection_closed : t -> unit Lwt.t 85 | val timeofday : t -> float 86 | -------------------------------------------------------------------------------- /src/server/ocsigen_response.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { a_response : Cohttp.Response.t 3 | ; a_body : Cohttp_lwt.Body.t 4 | ; a_cookies : Ocsigen_cookie_map.t } 5 | 6 | let make 7 | ?(body = Cohttp_lwt.Body.empty) 8 | ?(cookies = Ocsigen_cookie_map.empty) 9 | a_response 10 | = 11 | {a_response; a_body = body; a_cookies = cookies} 12 | 13 | let update ?response ?body ?cookies {a_response; a_body; a_cookies} = 14 | let a_response = 15 | match response with Some response -> response | None -> a_response 16 | and a_body = match body with Some body -> body | None -> a_body 17 | and a_cookies = 18 | match cookies with Some cookies -> cookies | None -> a_cookies 19 | in 20 | {a_response; a_body; a_cookies} 21 | 22 | let of_cohttp ?(cookies = Ocsigen_cookie_map.empty) (a_response, a_body) = 23 | {a_response; a_body; a_cookies = cookies} 24 | 25 | let to_cohttp {a_response; a_body; _} = a_response, a_body 26 | 27 | let status {a_response = {Cohttp.Response.status; _}; _} = 28 | match status with 29 | | `Code _ -> failwith "FIXME: Cohttp.Code.status_code -> status" 30 | | #Cohttp.Code.status as a -> a 31 | 32 | let set_status ({a_response; _} as a) status = 33 | { a with 34 | a_response = 35 | {a_response with Cohttp.Response.status :> Cohttp.Code.status_code} } 36 | 37 | let cookies {a_cookies; _} = a_cookies 38 | 39 | let add_cookies ({a_cookies; _} as a) cookies = 40 | if cookies = Ocsigen_cookie_map.empty 41 | then a 42 | else {a with a_cookies = Ocsigen_cookie_map.add_multi a_cookies cookies} 43 | 44 | let header {a_response; _} id = 45 | let h = Cohttp.Response.headers a_response in 46 | Cohttp.Header.get h (Ocsigen_header.Name.to_string id) 47 | 48 | let header_multi {a_response; _} id = 49 | let h = Cohttp.Response.headers a_response in 50 | Cohttp.Header.get_multi h (Ocsigen_header.Name.to_string id) 51 | 52 | let add_header 53 | ({a_response = {Cohttp.Response.headers; _} as a_response; _} as a) 54 | id 55 | v 56 | = 57 | { a with 58 | a_response = 59 | { a_response with 60 | Cohttp.Response.headers = 61 | Cohttp.Header.add headers (Ocsigen_header.Name.to_string id) v } } 62 | 63 | let add_header_multi 64 | ({a_response = {Cohttp.Response.headers; _} as a_response; _} as a) 65 | id 66 | l 67 | = 68 | let id = Ocsigen_header.Name.to_string id in 69 | let headers = 70 | List.fold_left (fun headers -> Cohttp.Header.add headers id) headers l 71 | in 72 | {a with a_response = {a_response with Cohttp.Response.headers}} 73 | 74 | let replace_header 75 | ({a_response = {Cohttp.Response.headers; _} as a_response; _} as a) 76 | id 77 | v 78 | = 79 | { a with 80 | a_response = 81 | { a_response with 82 | Cohttp.Response.headers = 83 | Cohttp.Header.replace headers (Ocsigen_header.Name.to_string id) v } 84 | } 85 | 86 | let replace_headers ({a_response; _} as a) l = 87 | let headers = 88 | List.fold_left 89 | (fun headers (id, content) -> 90 | Cohttp.Header.replace headers 91 | (Ocsigen_header.Name.to_string id) 92 | content) 93 | (Cohttp.Response.headers a_response) 94 | l 95 | in 96 | {a with a_response = {a_response with Cohttp.Response.headers}} 97 | 98 | let remove_header ({a_response; _} as a) id = 99 | let headers = Cohttp.Response.headers a_response 100 | and id = Ocsigen_header.Name.to_string id in 101 | let headers = Cohttp.Header.remove headers id in 102 | {a with a_response = {a_response with Cohttp.Response.headers}} 103 | -------------------------------------------------------------------------------- /src/server/ocsigen_response.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val make : 4 | ?body:Cohttp_lwt.Body.t 5 | -> ?cookies:Ocsigen_cookie_map.t 6 | -> Cohttp.Response.t 7 | -> t 8 | 9 | val update : 10 | ?response:Cohttp.Response.t 11 | -> ?body:Cohttp_lwt.Body.t 12 | -> ?cookies:Ocsigen_cookie_map.t 13 | -> t 14 | -> t 15 | 16 | val of_cohttp : 17 | ?cookies:Ocsigen_cookie_map.t 18 | -> Cohttp.Response.t * Cohttp_lwt.Body.t 19 | -> t 20 | 21 | val to_cohttp : t -> Cohttp.Response.t * Cohttp_lwt.Body.t 22 | val status : t -> Cohttp.Code.status 23 | val set_status : t -> Cohttp.Code.status -> t 24 | val cookies : t -> Ocsigen_cookie_map.t 25 | val add_cookies : t -> Ocsigen_cookie_map.t -> t 26 | val header : t -> Ocsigen_header.Name.t -> string option 27 | val header_multi : t -> Ocsigen_header.Name.t -> string list 28 | val add_header : t -> Ocsigen_header.Name.t -> string -> t 29 | val add_header_multi : t -> Ocsigen_header.Name.t -> string list -> t 30 | val replace_header : t -> Ocsigen_header.Name.t -> string -> t 31 | val replace_headers : t -> (Ocsigen_header.Name.t * string) list -> t 32 | val remove_header : t -> Ocsigen_header.Name.t -> t 33 | -------------------------------------------------------------------------------- /src/server/ocsigen_server.mli: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2005 4 | * Vincent Balat, Denis Berthod, Nataliya Guts, Jérôme Vouillon 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | val section : Logs.src 22 | 23 | val reload : ?file:string -> unit -> unit 24 | (** Reload the configuration of the server. The optional parameter 25 | [?file] may be used to read the configuration from another 26 | file. *) 27 | 28 | val exec : Xml.xml list list -> unit 29 | (** Start the server with a configuration file. Never returns. *) 30 | 31 | val start : 32 | ?ports:(Ocsigen_config.Socket_type.t * int) list 33 | -> ?ssl_ports:(Ocsigen_config.Socket_type.t * int) list 34 | -> ?ssl_info:Ocsigen_config.ssl_info option 35 | -> ?default_charset:string option 36 | -> ?logdir:string 37 | -> ?datadir:string 38 | -> ?uploaddir:string option 39 | -> ?maxuploadfilesize:int64 option 40 | -> ?syslog_facility:Syslog_message.facility option 41 | -> ?configfile:string 42 | -> ?usedefaulthostname:bool 43 | -> ?pidfile:string 44 | -> ?mimefile:string 45 | -> ?verbose:unit 46 | -> ?veryverbose:unit 47 | -> ?silent:unit 48 | -> ?daemon:unit 49 | -> ?debug:unit 50 | -> ?debugmode:bool 51 | -> ?minthreads:int 52 | -> ?maxthreads:int 53 | -> ?max_number_of_connections:int 54 | -> ?client_timeout:int 55 | -> ?server_timeout:int 56 | -> ?shutdown_timeout:float option 57 | -> ?filebuffersize:int 58 | -> ?maxrequestbodysize:int64 option 59 | -> ?maxrequestbodysizeinmemory:int 60 | -> ?bindir:string 61 | -> ?extdir:string 62 | -> ?command_pipe:string 63 | -> ?disablepartialrequests:bool 64 | -> ?respect_pipeline:unit 65 | -> ?maxretries:int 66 | -> Ocsigen_extensions.host_config list 67 | -> unit 68 | (** Start the server with some instructions. Never returns. 69 | It takes as main parameter a list of virtual hosts (see {!host} below). 70 | 71 | {% Options behave exactly like their <>%} 72 | counterparts. 73 | *) 74 | 75 | type instruction = 76 | Ocsigen_extensions.virtual_hosts 77 | -> Ocsigen_extensions.config_info 78 | -> Ocsigen_lib.Url.path 79 | -> Ocsigen_extensions.extension 80 | (** The type of instructions to be used inside an host or site. 81 | Instructions are defined by extensions (Staticmod, Eliom, etc.) *) 82 | 83 | val host : 84 | ?regexp:string 85 | -> ?port:int 86 | -> ?default_hostname:string 87 | -> ?default_httpport:int 88 | -> ?default_httpsport:int 89 | -> ?default_protocol_is_https:bool 90 | -> ?mime_assoc:Ocsigen_charset_mime.mime_assoc 91 | -> ?charset_assoc:Ocsigen_charset_mime.charset_assoc 92 | -> ?default_directory_index:string list 93 | -> ?list_directory_content:bool 94 | -> ?follow_symlinks:[`Always | `No | `Owner_match] 95 | -> ?do_not_serve_404:Ocsigen_extensions.do_not_serve 96 | -> ?do_not_serve_403:Ocsigen_extensions.do_not_serve 97 | -> ?uploaddir:string option 98 | -> ?maxuploadfilesize:int64 option 99 | -> instruction list 100 | -> Ocsigen_extensions.host_config 101 | (** You can define one or several virtual hosts corresponding to a given 102 | server name or port. *) 103 | 104 | val site : 105 | ?charset:string 106 | -> Ocsigen_lib.Url.path 107 | -> instruction list 108 | -> instruction 109 | (** Each host may contain some sub-sites corresponding to 110 | subdirectories in the URL.*) 111 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (subdir 2 | extensions 3 | (cram 4 | (package ocsigenserver) 5 | (deps 6 | ../server-test-helpers.sh 7 | (package ocsigenserver)))) 8 | -------------------------------------------------------------------------------- /test/extensions/deflatemod.t/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (libraries ocsigenserver ocsigenserver.ext.staticmod ocsigenserver.ext.deflatemod)) 4 | -------------------------------------------------------------------------------- /test/extensions/deflatemod.t/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.18) 2 | -------------------------------------------------------------------------------- /test/extensions/deflatemod.t/index.html: -------------------------------------------------------------------------------- 1 | Hello world 2 | -------------------------------------------------------------------------------- /test/extensions/deflatemod.t/run.t: -------------------------------------------------------------------------------- 1 | $ source ../../server-test-helpers.sh 2 | $ run_server ./test.exe 3 | ocsigen:main: [WARNING] Command pipe created 4 | ocsigen:access: connection for local-test from (curl/8.12.1): /index.html 5 | ocsigen:ext: [INFO] host found! local-test:0 matches .* 6 | ocsigen:ext:staticmod: [INFO] Is it a static file? 7 | ocsigen:local-file: [INFO] Testing "./index.html". 8 | ocsigen:local-file: [INFO] checking if file index.html can be sent 9 | ocsigen:ext: [INFO] Compiling exclusion regexp $^ 10 | ocsigen:local-file: [INFO] Returning "./index.html". 11 | ocsigen:access: connection for local-test from (curl/8.12.1): /index.html 12 | ocsigen:ext: [INFO] host found! local-test:0 matches .* 13 | ocsigen:ext:staticmod: [INFO] Is it a static file? 14 | ocsigen:local-file: [INFO] Testing "./index.html". 15 | ocsigen:local-file: [INFO] checking if file index.html can be sent 16 | ocsigen:local-file: [INFO] Returning "./index.html". 17 | ocsigen:ext:deflate: [INFO] Zlib stream initialized 18 | ocsigen:ext:deflate: [INFO] End of stream: big cleaning for zlib 19 | ocsigen:ext:deflate: [INFO] Zlib.deflate finished, last flush 20 | ocsigen:ext:deflate: [INFO] Flushing! 21 | ocsigen:ext:deflate: [INFO] Zlib stream closed 22 | application: [WARNING] Command received: shutdown 23 | 24 | First response is not compressed: 25 | 26 | $ curl_ "index.html" 27 | HTTP/1.1 200 OK 28 | content-type: text/html 29 | server: Ocsigen 30 | content-length: 12 31 | 32 | Hello world 33 | 34 | Second response is compressed: 35 | 36 | $ curl_ "index.html" --compressed 37 | HTTP/1.1 200 OK 38 | content-type: text/html 39 | content-encoding: gzip 40 | server: Ocsigen 41 | transfer-encoding: chunked 42 | 43 | Hello world 44 | -------------------------------------------------------------------------------- /test/extensions/deflatemod.t/test.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Logs.Src.set_level Deflatemod.section (Some Logs.Debug); 3 | Logs.set_level ~all:true (Some Logs.Debug); 4 | Ocsigen_server.start 5 | ~ports:[ (`Unix "./local.sock", 0) ] 6 | ~veryverbose:() ~debugmode:true ~logdir:"log" ~datadir:"data" 7 | ~uploaddir:None ~usedefaulthostname:true ~command_pipe:"local.cmd" 8 | ~default_charset:(Some "utf-8") 9 | [ 10 | Ocsigen_server.host 11 | [ Staticmod.run ~dir:"." (); Deflatemod.run ~mode:(`All_but []) () ]; 12 | ] 13 | -------------------------------------------------------------------------------- /test/server-test-helpers.sh: -------------------------------------------------------------------------------- 1 | # Bash functions that help test ocsigenserver 2 | 3 | # Run the server using 'dune exec -- "$@"' and doing the necessary setup. 4 | # The server must listen on the unix-domain socket named "local.sock" and on 5 | # the command-pipe named "local.cmd". 6 | # 7 | # Usage: 8 | # $ run_server ./test.exe 9 | # $ curl_ "index.html" 10 | # 11 | run_server () 12 | { 13 | mkdir -p log data # Directories that might be required by the server 14 | dune build "$1" 15 | # Run the server in the background, cut the datetime out of the log output. 16 | dune exec -- "$@" 2>&1 | cut -b 18- & 17 | # Wait for the unix-domain socket and the command-pipe to be created 18 | local timeout=50 # Don't wait more than 0.5s 19 | while ! ( [[ -e ./local.sock ]] && [[ -e ./local.cmd ]] ) && (( timeout-- > 0 )); do 20 | sleep 0.01 21 | done 22 | # Print an error if a file is missing 23 | ls ./local.sock ./local.cmd >/dev/null || return 1 24 | # Shutdown the server at the end of the test 25 | trap 'echo shutdown > local.cmd && wait' EXIT 26 | } 27 | 28 | # Wrapper around 'curl' that connects to the server. First argument is the 29 | # request path, the other arguments are directly passed to 'curl'. 30 | # 31 | # Usage: 32 | # $ curl_ "" 33 | # $ curl_ "index.html" 34 | # $ curl_ "index.html" --no-show-headers # Supress the headers 35 | # 36 | curl_ () 37 | { 38 | local path=$1; shift 39 | # Remove the 'date' header, which is unreproducible 40 | curl --unix-socket ./local.sock -s -i "$@" "http://local-test/$path" | \ 41 | grep -v "^date: " 42 | } 43 | --------------------------------------------------------------------------------