pax_global_header00006660000000000000000000000064152717056350014525gustar00rootroot0000000000000052 comment=619420c8163f99b6bbb391668285a72facddffed eliom-13.0.0/000077500000000000000000000000001527170563500127135ustar00rootroot00000000000000eliom-13.0.0/.github/000077500000000000000000000000001527170563500142535ustar00rootroot00000000000000eliom-13.0.0/.github/dependabot.yml000066400000000000000000000001601527170563500171000ustar00rootroot00000000000000version: 2 updates: - package-ecosystem: github-actions directory: / schedule: interval: weekly eliom-13.0.0/.github/workflows/000077500000000000000000000000001527170563500163105ustar00rootroot00000000000000eliom-13.0.0/.github/workflows/doc.yml000066400000000000000000000155351527170563500176110ustar00rootroot00000000000000# Build the Eliom documentation (manual + server/client API) with odoc_driver, # theme it with the Ocsigen chrome (wodoc), and publish it on the project's # gh-pages branch, served at https://ocsigen.org/eliom/. See doc/README.md. # # Two entry points: # - push to master (or "Run workflow" with no version) -> rebuild & deploy the # "dev" docs only. Each run replaces only dev/; the other version directories # already on gh-pages are PRESERVED. # - "Run workflow" with a version -> the `release` job freezes the dev docs now # on gh-pages as // and repoints `latest` at it (refreshing # versions.json). No rebuild: a release is exactly the dev docs at that point. # # PREREQUISITE: wodoc builds the API with `odoc_driver eliom --remap` on the # INSTALLED eliom, and eliom's cross-library links need the odoc_driver `base_args` # fix, which is not yet upstreamed. Until it lands, the "Install dependencies" step # must pin odoc / odoc-driver from the patched source (see below). name: Documentation on: push: branches: [master] workflow_dispatch: inputs: version: description: "Publish a stable version: freeze the dev docs now on gh-pages as // and repoint `latest` (e.g. 12.0). Leave empty to just rebuild dev." required: false default: "" # Serialise gh-pages writes: a push (rebuilds dev/) and a release # workflow_dispatch (freezes / and repoints latest) must never push to # gh-pages at the same time, or the second push fails non-fast-forward. concurrency: group: doc-deploy-${{ github.workflow }} cancel-in-progress: false jobs: build-deploy: # push, or a manual run with no version (just rebuild dev). NOT a release run. if: github.repository == 'ocsigen/eliom' && (github.event_name != 'workflow_dispatch' || github.event.inputs.version == '') runs-on: ubuntu-latest permissions: contents: write steps: - name: Checkout uses: actions/checkout@v7 with: fetch-depth: 0 - name: Set up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: "5.4.0" - name: Set up Binaryen # eliom depends on wasm_of_ocaml-compiler, whose build needs a recent # binaryen (wasm-merge); distro binaryen is too old. Same action as # js_of_ocaml's own CI. uses: Aandreba/setup-binaryen@v1.0.0 with: token: ${{ github.token }} # The bottleneck of this job is compiling the dependency tree (~6 min): lwt, # js_of_ocaml, wasm_of_ocaml, react, tyxml, ocsigenserver... plus wodoc/odoc # from source. setup-ocaml only caches the base switch (the compiler), so # they recompiled on every push. Cache the whole _opam switch keyed on # eliom.opam (the dep set) and wodoc's HEAD commit. On a cache hit the deps # and wodoc are restored and only eliom itself is (re)built below; the key # changes — and the deps/wodoc rebuild once — only when eliom.opam or wodoc # move. - name: Resolve wodoc HEAD commit id: wodoc run: echo "sha=$(git ls-remote https://github.com/ocsigen/wodoc.git HEAD | cut -f1)" >> "$GITHUB_OUTPUT" - name: Cache the opam switch (deps + wodoc) id: switch-cache uses: actions/cache@v6 with: path: _opam key: opam-switch-${{ runner.os }}-ocaml5.4.0-${{ hashFiles('eliom.opam') }}-wodoc-${{ steps.wodoc.outputs.sha }} - name: Install dependencies and wodoc # Cache miss only: build the dependency tree and wodoc once, then re-cache. if: steps.switch-cache.outputs.cache-hit != 'true' run: | opam install . --deps-only --with-doc # wodoc themes the pages. Its opam pin-depends pulls odoc / odoc-driver # from the balat/odoc fork (the cross-library link fix, not yet upstream), # so we do NOT pin odoc ourselves here. opam pin add -n wodoc https://github.com/ocsigen/wodoc.git opam install wodoc - name: Install eliom # Always: eliom's own sources change on every push, so odoc_driver must # document the freshly-built package. eliom is installed WITHOUT --with-doc: # its server and client libraries share module names, so building eliom's # own @doc collides ("Multiple rules for .../eliom/Eliom_bus/index.html"). # wodoc builds the docs via `odoc_driver --remap` instead. run: opam install . - name: Build documentation (dev) # wodoc build runs `odoc_driver eliom --remap` on the installed package # (after preprocessing the installed manual .mld), assembles the themed # site from doc/wodoc, and fetches the shared menu from ocsigen.github.io. run: >- opam exec -- wodoc build --config doc/wodoc --menu https://ocsigen.org/doc/menu.html --out "$PWD/_doc-site/dev" --label dev --strict-refs - name: Deploy to gh-pages (replace only dev/, keep the rest) uses: JamesIves/github-pages-deploy-action@v4 with: branch: gh-pages folder: _doc-site/dev target-folder: dev clean: true release: # Manual run with a version: freeze the dev docs currently on gh-pages as the # stable // and repoint `latest` at it (refreshing versions.json). # No rebuild — the docs of a release are exactly the dev docs at that point. if: github.repository == 'ocsigen/eliom' && github.event_name == 'workflow_dispatch' && github.event.inputs.version != '' runs-on: ubuntu-latest # Pass the user-supplied version through the environment; never interpolate # it directly into a run: shell (avoids command injection from the input). env: VERSION: ${{ github.event.inputs.version }} permissions: contents: write steps: - name: Set up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: "5.4.0" - name: Install wodoc run: | opam pin add -n wodoc https://github.com/ocsigen/wodoc.git opam install wodoc - name: Checkout gh-pages uses: actions/checkout@v7 with: ref: gh-pages path: site fetch-depth: 0 - name: Freeze dev as the stable version and repoint latest # wodoc release: cp -a site/dev site/, ln -sfn latest, # write the root index.html redirect if missing, refresh versions.json. run: >- opam exec -- wodoc release --site site --from dev --version "$VERSION" - name: Commit and push gh-pages run: | cd site git config user.name "github-actions[bot]" git config user.email "github-actions[bot]@users.noreply.github.com" git add -A git diff --cached --quiet \ || git commit -m "Release doc $VERSION (freeze dev, repoint latest)" git push eliom-13.0.0/.github/workflows/workflow.yml000066400000000000000000000067451527170563500207210ustar00rootroot00000000000000name: Main workflow on: pull_request: # ready_for_review adds the macOS job, which draft PRs skip types: [opened, synchronize, reopened, ready_for_review] push: branches: - master schedule: # Every Monday: prime the caches, and test js_of_ocaml master - cron: 0 1 * * MON concurrency: group: ${{ github.workflow }}-${{ github.head_ref || github.ref }} cancel-in-progress: ${{ github.event_name == 'pull_request' }} jobs: build: strategy: fail-fast: false matrix: # Draft PRs skip macOS: the organisation runs only 5 macOS jobs at # a time. os: ${{ fromJSON(github.event.pull_request.draft && '["ubuntu-latest"]' || '["macos-latest", "ubuntu-latest"]') }} ocaml-compiler: - 5 - 4 # OCaml 4 on Linux only: macOS-specific bugs show with OCaml 5. exclude: - os: macos-latest ocaml-compiler: 4 runs-on: ${{ matrix.os }} steps: - name: Checkout tree uses: actions/checkout@v7 - name: Set-up OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-pin: false dune-cache: true # The client tests run under Node.js; WebAssembly GC needs Node.js 22 # or later. - name: Set-up Node.js uses: actions/setup-node@v7 with: node-version: 24 # wasm_of_ocaml needs Binaryen 120 or later - name: Set-up Binaryen uses: Aandreba/setup-binaryen@v1.0.0 with: token: ${{ github.token }} # The macOS image defaults to OpenSSL 4, which has no SSLv3: ssl 0.8.0 # then fails to create Conduit's default server context, and every # test server dies at startup. Build ssl against OpenSSL 3 until ssl # handles it. - if: runner.os == 'macOS' run: echo "PKG_CONFIG_PATH=$(brew --prefix openssl@3)/lib/pkgconfig" >> "$GITHUB_ENV" # The weekly run also tests js_of_ocaml master - if: github.event_name == 'schedule' && runner.os == 'Linux' && matrix.ocaml-compiler == 5 run: opam pin -y git+https://github.com/ocsigen/js_of_ocaml#master - run: opam install . --deps-only --with-test -y - run: opam exec -- dune build -p eliom,eliom-compat - run: opam exec -- dune runtest -p eliom,eliom-compat # Browser tests (test/e2e), not required to pass for now - name: Browser tests id: e2e if: runner.os == 'Linux' && matrix.ocaml-compiler == 5 continue-on-error: true working-directory: test/e2e env: E2E_BROWSERS: chromium,firefox,webkit run: | opam exec -- dune build @app/all npm ci npx playwright install --with-deps chromium firefox webkit npx playwright test # With continue-on-error, failure() stays false: test the outcome - name: Upload the logs of the browser tests if: steps.e2e.outcome == 'failure' uses: actions/upload-artifact@v7 with: name: browser-tests path: | test/e2e/server-data/**/*.log test/e2e/test-results/ if-no-files-found: ignore lint-fmt: runs-on: ubuntu-latest steps: - name: Checkout tree uses: actions/checkout@v7 - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: 4 dune-cache: true - uses: ocaml/setup-ocaml/lint-fmt@v3 eliom-13.0.0/.gitignore000066400000000000000000000003541527170563500147050ustar00rootroot00000000000000*~ #* *# .#* _build eliom.install src/**/*.mllib src/**/*.mldylib # Generated odoc/wodoc documentation output _wodoc-html/ _wodoc-md/ ocsigen.org-data _opam # Local files (not part of the project) AGENTS*.md instructions 2026-*.md eliom-13.0.0/.ocamlformat000066400000000000000000000016341527170563500152240ustar00rootroot00000000000000version=0.29.0 parse-docstrings = false wrap-comments = false break-cases = fit break-collection-expressions = fit-or-vertical break-fun-decl = wrap break-fun-sig = wrap break-infix = wrap break-infix-before-func = false break-sequences = false break-separators = before break-string-literals = never break-struct = force cases-matching-exp-indent = compact doc-comments = after-when-possible dock-collection-brackets = false indicate-multiline-delimiters = no infix-precedence = indent let-and = compact let-binding-spacing = compact module-item-spacing = compact parens-tuple = multi-line-only parens-tuple-patterns = multi-line-only sequence-style = terminator sequence-blank-line = compact single-case = compact type-decl = compact if-then-else = keyword-first field-space = loose space-around-arrays = false space-around-records = false space-around-lists = false space-around-variants = false ocp-indent-compat = true eliom-13.0.0/.ocp-indent000066400000000000000000000000521527170563500147510ustar00rootroot00000000000000normal with=0 syntax=lwt mll max_indent=2 eliom-13.0.0/CHANGES000066400000000000000000002416521527170563500137200ustar00rootroot00000000000000===== 13.0.0 (2026-11-01) ===== * Dependencies ** Requires OCaml >= 4.14, Ocsigen Server >= 8.0 (wrapped module names), TyXML >= 5.0, ocsipersist >= 3.1 (JSON frontends with the Decoding_error exception) and js_of_ocaml >= 6.4. BREAKING: TyXML 5 changes some element and attribute types; see TyXML's own changelog. * PPX: the Eliom syntax extension is now a no-op on plain .ml/.mli files; only .eliom/.eliomi files are processed as client-server code. This prevents server-only .ml modules that create services at toplevel from emitting client values that are never linked on the client (reported as "Code generating the following client values is not linked on the client"). * PPX: the client pass reports a -server-cmo file shorter than an object file header as "not an object file", instead of failing with End_of_file. * PPX: the client pass reports a client value whose type is missing from the -server-cmo file like a missing injection ("You need to regenerate ..."), instead of failing with an exception. * PPX: a section without colon in an interface, [%%client val x : t], says that it takes a signature ([%%client: ...]), instead of "Sections are only allowed at toplevel". An empty [%%client] in an interface asks, as in an implementation, whether [%%client.start] was meant. * Persistent storage: replace Stdlib.Marshal with Deriving_Json ** perssessgrp values (session-group keys) are now serialised with Deriving_Json instead of Stdlib.Marshal. The on-disk format becomes stable across OCaml versions and human-readable. BREAKING: existing session-group entries from older Eliom versions become unreadable; the affected tables are renamed (see the entries below) so that the old data is never misread. ** Persistent-cookie table (eliom_persist_cookies) now uses Ocsipersist.Column.Json instead of Column.Marshal. The table suffix is bumped to _v6. BREAKING: persistent cookies issued by earlier Eliom versions are dropped on upgrade and clients are asked to remove the cookie on next visit. ** Session-group table is migrated from Ocsipersist.Polymorphic to a typed functorial table with Column.Json. Renamed from __eliom_session_group_table to __eliom_session_group_table_v2. BREAKING: existing session groups are dropped on upgrade. ** Eliom references and persistent session-data tables drop all reliance on Stdlib.Marshal. The user-facing API now requires a Deriving_Json codec: Reference.eref ~persistent:("name", [%json: t]) v State.create_persistent_table ~scope ~json:[%json: t] "name" The stored values must be annotated with [@@deriving json]. Internally: - The global persistent store (Ocsiper) now uses Ocsipersist.Store_json. - Per-site and per-user persistent tables use a typed Ocsipersist functorial table with Column.Json registered via Persistent_tables.create_json. These tables are named with a "_json_" prefix, so they never share a name with the pre-13 Marshal-encoded table (which used the bare name). The column type also changes (bytea -> text), so reusing the old table would be incorrect: the stale Marshal tables are left orphaned instead, and Eliom 13 starts from fresh tables. - The vestigial int64 column previously prefixed to every session value is dropped. - Ocsipersist.Polymorphic is no longer used in Eliom and the Common.Ocsipersist.Polymorphic wrapper is removed. BREAKING: on upgrade from Eliom 12, all persistent data (references, per-session and per-site state, cookies and session groups) is left behind and resets to its default value, because the JSON tables use new names and the old Marshal tables are never read. The old tables are kept on disk, not deleted. This reset concerns more than sessions: group-scope persistent references are commonly keyed by user and hold durable per-user data (preferences, ...), which silently restarts from the default. Applications that cannot afford this should export such data before upgrading, with the Eliom 12 version of the application (for example into their SQL database), and re-import it through the new API; reading the orphaned Marshal tables later requires code built with the old types. A value that cannot be deserialised never raises: it is treated as an absent value (fresh session / default reference) instead of a 500 error, and the fallback is logged (sources "eliom" and "eliom:reference"). * Module namespace modernization ** Public modules are now accessed as Eliom.Service, Eliom.Content, Eliom.Parameter, Eliom.Registration, Eliom.Client, ... instead of the legacy flat Eliom_xxx prefix. Implemented with (include_subdirs qualified) + (wrapped false) in dune. ** Eliom_common is now Eliom.Common; most internal modules lost their eliom_/eliommod_ prefix as well (Content_core, Mod_main, Mod_pagegen, ...). A few names are kept as-is for conflict reasons (Eliom_form, Eliom_lazy, Eliom_react, Eliom_uri). ** New eliom-compat opam package: provides the legacy Eliom_xxx module names as include-aliases of the new Eliom.Xxx modules, to ease migration of existing code. ** BREAKING: Eliom.run is now Eliom.App.run (the auto-generated wrapper module cannot contain val declarations). * Eliom.Content.Html.T ** New named module type for the Tyxml HTML signature shared by F and D, with Eliom's LINKS_AND_FORMS extensions. Use it as the parameter signature of functors that need to abstract over the F/D choice, instead of [module type of Content.Html.F]. The latter triggers an OCaml strengthening bug in wrapped libraries. Tools.Make, Ot.Icons.Make and the os_template Make functor all use it. * Distillery template install path ** Eliom's templates (app, basic.ppx) are now installed at lib/eliom/templates// via the standard dune (install (section lib_root) ... (with_prefix ...)) pattern. Third-party packages (e.g. ocsigen-start) that ship templates are expected to install at the same location. * Build system ** Migrated to wrapped ocsigenserver module names (Ocsigen.Server, Ocsigen.Extensions, Ocsigen.Request, Ocsigen.Response, Ocsigen.Config, Ocsigen_base.Lib, Ocsigen_http.Header, ...). ** PPX gained -internal and -internal-prefix flags for compiling wrapped libraries. ** Removed the eliom.ocamlbuild plugin and the legacy topkg/pkg build artifacts. The manual is now written as odoc pages (doc/*.mld) and the API documentation is generated with odoc; both are built and published on ocsigen.org by wodoc (see doc/wodoc and the doc.yml workflow). * Exception renames ** Common.Eliom_site_information_not_available is now Common.Site_information_not_available, Common.Eliom_do_redirection is now Common.Do_redirection, and Common.Eliom_do_half_xhr_redirection is now Common.Do_half_xhr_redirection. The old names are kept as backwards-compatible aliases (exception X = Y). ** The internal client exception Request_info.Eliom_no_raw_post_data_on_client was renamed to No_raw_post_data_on_client (no alias kept, as it was not exposed). * New exception Common.Request_information_not_available, raised by the functions that need the current request when they are called outside one: Common.get_sp (and the functions using it, which raised Failure), and registering a service with a session, session group or client process scope (which raised Failure "Missing sp while registering service"). * Browser support ** The client side of Eliom applications now requires a browser with the History API, querySelectorAll, compareDocumentPosition, document.createEvent and addEventListener, that is any browser since Internet Explorer 10. The fallbacks for older browsers (URLs encoded in the fragment, DOM walks, Internet Explorer 8 workarounds) are removed. ** Mod_dom.onhashchange, which served the fragment fallback, is removed. ** Mod_dom.select_nodes returns a selected_nodes record instead of a 5-tuple of node lists. ** A form submitted through XHR sends the button that submitted it, as given by SubmitEvent.submitter, instead of the target of the last click in the page. Clicking an element inside a button (an icon, a span) now sends the button, as a native submission does, and a form submitted by a script (requestSubmit) no longer sends a button clicked earlier. Browsers without SubmitEvent.submitter (Safari before 15.4, Chrome before 81) send no button. Request.send_get_form and Request.send_post_form take the button as a new ?submitter argument. Mod_dom.add_formdata_hack_onclick_handler is removed. ** A form submitted by a button with a formaction, formmethod, formenctype or formtarget attribute is submitted by the browser, not through XHR, since Eliom does not know the service it goes to. These attributes were ignored. A client application still submits the form through XHR, ignoring them, and logs a warning. * Logging ** The Comet client logs its connection and request failures as warnings (source eliom:comet) instead of application messages (Logs.app), so that they can be filtered like the other Eliom logs. ** The server logs the update of the expiry dates of all sessions after a change of timeout at info level (source eliom:admin) instead of as an application message (Logs.app). ** Eliom_react (client) logs under its own source, eliom:react, instead of eliom:comet. ** On the client, the exceptions passed to Lwt.async_exception_hook are logged with Logs.err (source eliom), followed by the JavaScript stack when the exception carries a JavaScript error, instead of being written with console.error. * Non-attached coservices created during the initialisation of a site and not registered then are reported by a warning in the logs. Services with a path still prevent the server from starting; non-attached coservices only warn, since libraries create some that applications may not use. Service.allow_unregistered tells that a service may be left unregistered: a service registered later, during requests, as the service of a bus of client processes is, or a service that a library creates for a feature that applications may not use. * Comet: Config.set_comet_timeout and the option set the time after which the server answers a Comet request waiting for data with no data. It was fixed to 20 s, still the default. * Distillery templates no longer set the data directory of Ocsigen Server (, ~datadir), which is going away. basic.ppx now gives Ocsipersist its location itself ( for dbm, for sqlite). * Distillery templates app.exe and app.lib are merged into one template, app, whose build rules are generated by ocsigen-dune-rules. The project runs either in its own executable (dune exec ) or as an Eliom module loaded by the ocsigenserver command with .conf. The template is maintained in the eliom_template_exe repository; script/update_templates.sh copies it here. * : the configuration of the element is now visible to every file loaded for it, not only to the last one. The libraries of an application split into several packages, as the templates now are, read it when they are loaded as dependencies. * Registration.set_status sets the HTTP status of the answer to the current request from a service handler, which then returns its page as usual: set_status `Not_found for a page about something that does not exist. It takes precedence over the ?code given at registration, and is dropped if the handler raises an exception. It does nothing on the client, so that %shared handlers can call it. Registration.get_status reads it. * Registration.set_exn_handler accepts a handler sending any kind of content, not only browser content: My_app.send ~code:404 sends a page of the application for unknown URLs, which the client-side program displays without leaving the application. * BREAKING: the maximum numbers of sessions and of anonymous services given to App.run are all integers. Five of them were pairs, whose boolean said whether the program could change the value without ~override_configfile:true. They are now all kept, as those of a configuration file. To migrate, replace (n, _) by n. For a maximum number of sessions that the program changes later, call State.set_default_max_* with ~override_configfile:true. The maximum number of anonymous services per session has no State.set_default_max_* function: the boolean of its pair had no effect. * The redirection services accept the option `NotModified for a 304 answer. The misspelled `NotNodifed is still accepted. * New Request_info.get_client_conn returns the connection of the client (Ocsigen.Request.client_conn). Unlike get_client_conn_to_string, meant for logs, it gives the address itself, also behind a trusted reverse proxy. * Parameter.suffix and suffix_prod raise Invalid_argument for a suffix that contains any, unit, a file, raw POST data or non-localised parameters, or a list or a set that does not end the path. Such a service type-checked, then failed at each request. * BREAKING: the client-side modules Registration.Block5, Text and Streamlist are removed, and so are those of Eliom_registration in eliom-compat. They had no server-side counterpart, so shared code using them did not compile on the server. Use Service.non_ocaml instead of their return type. * Session groups ** The sessions that are not in a session group are now counted together for the whole site, 1000000 by default, instead of 1000000 per sub network of the client. The sub network was the one of the reverse proxy for every client, or one of the many an IPv6 client has, so the limit neither bounded the memory of the server nor isolated an attacker from the other users. New names: State.set_default_max_volatile_sessions_without_group (and the service and data variants), and the option (and , ), which apply at once, also when the server reads the configuration of a site again. The old names are removed, as are the sub networks of the sessions; an old option is a configuration error, also in the configuration of a site. Common.session_group has No_group instead of Subnet. The group of the sessions without a group is not one of the groups of the site: when the site has too many groups, it is not closed with all its sessions at once. A service registered with the session-group scope for a session without a group is registered for the session, as the data of the group scope are. ** The anonymous coservices registered in the global table during requests are now limited for the whole site, 500000 by default, instead of 500000 per sub network of the client, for the same reasons as the sessions without a group. The anonymous coservices registered during the initialisation of the site are no longer counted: they shared the list of the clients connected through a Unix socket or from ::1 (all the clients of a reverse proxy connected that way), and requests could remove them. The option becomes , and the new State.set_default_max_anonymous_services_per_site sets this limit. The options and , and State.set_ipv4_subnet_mask and set_ipv6_subnet_mask, are removed: an old option is a configuration error. Eliom no longer depends on ipaddr. ** State.set_max_*_states_for_group_or_subnet are renamed set_max_*_states_in_parent. With a session scope, for a session that is not in a group, they no longer change the limit of all the sessions without a group (a warning is logged); with a session group scope, they change the limit of groups of the site also for a session without a group. The optional parameter ?set_max of State.unset_service_session_group and unset_volatile_data_session_group is removed: it set the limit of the sessions without a group. ** The services registered with the session-group scope are now found. Eliom looked for services in the tables of the sessions and in the global table only, never in the table of a group. ** A browser service session in a session group is no longer closed with its last tab service session, as for data sessions. When it had no service of its own, it was closed, which took it out of its group and could close the services of the group. Afterwards, State.get_service_session_group returned None. ** When a site has too many session groups (, State.set_max_*_states_in_parent with a session-group scope), the group used least recently is closed: a request of a session of a group moves the group up. The oldest group was closed, even if it was in use. ** The maximum numbers of sessions, session groups and anonymous coservices must be positive: State.set_default_max_*, set_max_*_states_in_parent, the ?set_max parameters of the functions setting a session group, Config.set_max_*, App.run and the options of the configuration file reject 0 or less (Invalid_argument, or a configuration error). A limit of 0 behaved as 1, or raised Failure "Dlist.set_maxsize" on a group that was not empty. In the configuration of a site, an option of Eliom with a wrong value is now an error too: it was left to the Eliom modules, and ignored. ** The default maximum number of tab sessions in a browser session is now 100 instead of 50. A closed tab does not tell the server, so the limit must exceed the number of tabs of the site that a user keeps open at the same time; beyond it, the tab session used least recently is closed. * Compatibility with the WebAssembly text parser of the next wasm_of_ocaml, which has no tuple types * Bug fixes ** The JavaScript client reads the nativeint values sent by the server, as the WebAssembly client does (32 bits on the client), instead of failing with "unknown custom block identifier". ** App.run: the options that it is not given (secure cookies, application script, global data caching, HTML content type, ignored parameters, omitpersistentstorage) take the defaults set with the functions of Config. In a statically linked executable, the site of the default application exists before the toplevel code of the modules runs, so these functions had no effect on it, except Config.set_enable_wasm. ** Syntax.is_site_available now checks that the sitedata stack is actually non-empty during initialisation, instead of just relying on Ocsigen.Extensions.during_initialisation. Fixes a crash on startup (Eliom_site_information_not_available "get_current_sitedata") exposed by the new module link order: PPX-inserted top-level close_server_section calls in extension-linked .eliom files (Service_base, Content, Tools, ...) now correctly route their compilation-unit data into !global_data when no site is active, matching the design intent stated in the comment on get_global_data. ** Client values created during site initialisation (register_site_init callbacks: set_ignored_params, the Comet fallback services) are now flushed into a dedicated section (__eliom_site_init__) and consumed by the client in do_request_data, instead of leaking into the next loaded module's section. Previously they were reported as unlinked on the client whenever that module was not linked there (e.g. an unused Ot widget), and set_ignored_params was in fact never reliably applied. ** State.set_global_volatile_data_state_timeout and set_global_persistent_data_state_timeout with ~recompute_expdates:true now recompute the expiration dates of data and persistent states. They used to recompute those of service states instead. ** State.set_default_global_persistent_data_state_timeout now sets the default timeout of persistent states. It used to set the default timeout of service states. ** State.set_max_service_states_in_parent and set_max_volatile_data_states_in_parent (then named set_max_*_states_for_group_or_subnet) with a session group scope now change the maximum number of session groups of the site also when the group has no state of the other kind. They looked the group up in each other's table, and did nothing in that case. ** State.unset_service_session_group now keeps a browser service session that still has tab service sessions. It used to count the tab data sessions instead, and could close a browser session in use. ** Notif.S.clean no longer removes entries from the table while iterating over it, which the Stdlib leaves unspecified. ** Notif.S.notify ~notfor:(`Id id) now compares identities with the equal_identity function of the functor argument instead of the polymorphic equality. ** Client-side error messages about client values and injections now show the whole source range of the expression instead of its first character only. ** The PPX now builds with any supported ppxlib on any supported OCaml version. It selected the shape of Pexp_fun and Typ.alias from the compiler version instead of the ppxlib AST version, and failed to build, for instance, on OCaml 4.14 with ppxlib >= 0.36. ** Shared.React.S.Lwt.merge_s now marks its result as synced only when all the merged signals are synced, like merge and the l*_s functions. It used to take the flag of the last signal of the list. ** On the client, calling a PUT or DELETE service (Client.call_service, change_page...) now sends a PUT or DELETE request. Request.http_put and http_delete used to send a POST request. Request.send takes a new optional ~override_method parameter. ** Content.Html.Id.get_element and Content.Svg.Id.get_element now return None when no element has the given id, as documented. They used to raise Not_found. ** A malformed configuration now raises Error_in_config_file with a message instead of an Assert_failure. ** A non-integer cache attribute of now raises Error_in_config_file instead of an uncaught Failure. ** The value "infinity" of the , , and options now disables the corresponding garbage collection, as intended. It used to start a collector sleeping for an infinite time. ** State functions on persistent states (get_persistent_data_cookie, get_persistent_data_state_timeout, unset_persistent_data_state_timeout, get_persistent_data_session_group, unset_persistent_data_session_group, remove_persistent_data, Ext.discard_state) now return a rejected promise on an unexpected error. When the error was already known, as with a synchronous storage backend, they raised it synchronously instead. ** Getting a persistent Eliom reference now returns a rejected promise on a storage error. With a synchronous storage backend, the error was raised synchronously instead. ** A stateless Comet request whose wait fails immediately now gets a rejected promise instead of a synchronous exception. ** On the client, Request.send (hence change_page, call_service, ...) now returns a rejected promise when the XHR fails immediately, instead of raising the error synchronously. ** On the client, writing to a Bus now returns a rejected promise when the call to the bus service fails immediately, instead of raising the error synchronously. ** On the client, a service handler whose parameters cannot be decoded now returns a rejected promise instead of raising the error synchronously when the decoding fails immediately. ** On the client, Comet.Configuration.set_always_active c true now keeps the Comet connection active when the page is hidden, as documented, also when c is the only configuration or when several configurations are set. The combined configuration repeated the idle policies, so the test for an always active configuration never matched, and the client went idle after the timeout, polling without delay. ** On the client, Lib.Url.string_of_url_path ~encode:true now encodes each path segment, like the server version. It used to ignore ~encode and print a warning. ** Volatile session groups: the service sessions and the data sessions of a group are now closed separately. Closing the last service session of a group closed the data sessions of the group and removed its group data. State.discard_services ~scope:(`Session_group _) closed the data sessions of the group instead of its service sessions, so State.discard with that scope left the service sessions open. Evicting the service sessions of a group, when a site has too many groups, also closed its data sessions instead. ** State.Ext.get_session_group_list lists each session group once. It listed twice a group with both service and data sessions. ** Wrapping a value for the client now applies the wrapper of a value shared inside it only once, and keeps the sharing, also when a garbage collection moves the shared value while it is wrapped. The wrapper used to be applied again, for instance the data of Eliom_lazy values computed twice. ** A wrapper whose result is an immediate value (an integer, a boolean, a constant constructor such as None or []) is now applied once and its result sent to the client, like any other result. The results 0, 1 and 2 were confused with the markers of the traversal: the wrapper of a shared value ran again for 0, the value was sent unwrapped for 1, which failed to marshal, and 2 failed an assertion. ** App.run now checks that the services created during the initialisation of the application are registered, as for a site of a configuration file: it raises Common.Eliom_there_are_unregistered_services for services with a path, so that the server does not start, and warns about non-attached coservices. BREAKING: a statically linked executable that leaves a service with a path unregistered no longer starts. Ocsigen Server checks the sites of a configuration file only, so statically linked applications were never checked. ** Using an Eliom reference of site scope outside a request and outside the initialisation of a site now raises Common.Site_information_not_available, as documented, instead of Failure "get_site_data". ** The Cache-Control header set by the ~options of Registration.String, CssText, File and File_ct is now max-age=N. It was written max-age: N, which caches do not understand. ** Text content sent by the registration modules no longer has an empty charset (content-type: text/plain; charset=) when the server has no default charset. ** A value of a suffix parameter containing a slash now reaches the service. Eliom writes it %2F in URLs, but decoded the request path with Ocsigen.Request.sub_path, which splits again encoded slashes, so the request did not match (400), and relative URLs computed on such a page went one level too high. Such a value may thus contain "../", and must be checked before being used as a file name. Whole suffixes (all_suffix, all_suffix_string, all_suffix_user) are still split on slashes, without ".." segments. ** The ".." segments of a whole suffix (all_suffix, all_suffix_string, all_suffix_user) given as a parameter, in the version of a service without suffix, are now removed, as they are from a path. ** State.discard, discard_data and discard_services with a session group scope now close the group, with all its browser sessions, as documented. They looked the state of the group up under a name that no cookie has, so they did nothing: neither the data (volatile and persistent) nor the services of the group and of its sessions were removed. A session that is not in a session group is closed alone: it is its own group, as for the data of the group scope (the automatic group of such sessions holds the sessions of other users). ** A form submitted through XHR by an image button (Form.image_input) sends the point of the click as name.x and name.y, as a native submission does, so that the service receives its Parameter.coordinates. The point was not sent, and the service rejected the request. ** The garbage collectors of sessions of a statically linked application now use the frequencies set by the application before App.run (Config.set_session_gc_frequency and the like). They were started when Eliom was loaded, before the code of the application ran, with the default frequencies. ** The garbage collectors of sessions compare expiration dates with the current time to a fraction of a second, as the checks done when a state is accessed. They used whole seconds, and collected a state up to one second after it had expired. ** A Comet channel of a client process created with a size keeps at most that number of messages before telling the client that messages were lost (Full). It kept one more. ** The Last (Some n) position of a stateless Comet request, used by Comet.Channel.external_channel ~history:n, now returns the n last messages. It returned n + 1. ** A stateless Comet channel (Comet.Channel.create and create_from_events with ~scope:`Site, create_newest, Eliom_react.Down.of_react ~scope:`Site) now keeps the stream of its messages alive as long as the channel. A stream made from a React event was kept by nothing else, and the channel stopped receiving messages after a garbage collection. ** Reference.modify on a persistent reference of site scope, started during the initialisation of a site, no longer fails with Site_information_not_available when it ends after the initialisation (for instance when run by Lwt.async). ** A persistent Eliom reference of site scope identifies a site by its directory only, as sessions do, and no longer by the default host name of its host, which depends on the machine when it is not configured: the values were lost when the machine or its name changed (a new container, for instance). Sites at the same path of different virtual hosts now share the values. ** A malformed value of a Parameter.ocaml parameter is now a typing error of the parameters, as for the other types of parameters: the server answers 400 or calls the error handler of the service. The Failure of the JSON decoder escaped, and the server answered 500 and logged an error. ** A stateful Comet request sent to the service of stateless channels, or a stateless one sent to the service of a client process, is now answered with a Comet_error. The server raised Failure and answered 500. ** Eliom_react.S.Down.of_react ~scope:(`Client_process h) now sends the signal on a channel of the client processes of the hierarchy h. It used the default scope of client processes, as when no scope is given. ** Comet.Channel.external_channel works again. The service of stateless channels is again a POST service on the path __eliom_comet_global__, as external channels expect. It had become an attached coservice, whose random name and prefixed parameters another server cannot know, and the requests of external channels got 404. ** Two attached coservices with the same name, fallback and parameters, registered during the initialisation of a site, now raise Eliom_duplicate_registration, as services with a path and non-attached coservices do. The second one silently replaced the first one. ** Tools.F.structure_links and Tools.D.structure_links now link to the main page of the section of the current page with rel="up", and to the main pages of its subsections with rel="subsection", in the order of the site, as documented. All the links had rel="next", which means the next document of a series, and the subsections came in reverse order. ** The result of the ~error_handler of a service sending OCaml values (Registration.Ocaml, and Client.server_function) is now sent as a result of the service, which the client-side program expects; an exception of the error handler is logged and its code sent, as for the handler of the service. The result was sent alone, and the client-side program read it as a value of another type. ** eliom-distillery chooses the persistent-data backend of the basic.ppx template among the installed ocsipersist-*-config packages: sqlite, then dbm, then pgsql, and sqlite when none is installed. It looked for the old names ocsipersist.dbm and the like, never found them, and always chose dbm, which is not available on macOS. ** A persistent Eliom reference of global scope now accesses the database only when it is read or written, as the other persistent references do. It accessed it when created, often at the toplevel of a module, which could be before the application configured Ocsipersist (the location of the SQLite database, for instance): the reference then failed for good, or used another database. ** The list of the persistent sessions of a group is no longer overwritten by simultaneous requests of the group, such as two logins of the same user at the same time: a session dropped from the list escaped the limit of the group and State.discard with the group scope. The operations on a group are now serialised within a server process (several processes sharing a database can still lose an update); a request of the session already first in the list no longer writes it back, and a request of a session that has left the list (closed by the limit while the request runs) no longer puts it back. Simultaneous logins of a session list it once: it was listed twice, and took two places in the limit. Closing a group removes its data before its sessions are closed, and keeps a session that joins it meanwhile, and a session that could not be closed. A session missing from the list of its group (possible when several server processes share a database) stays out of it until it expires. ** A persistent session found expired at a request is now closed with its tab sessions, and leaves its session group, as the collection of expired sessions does. Only its data were removed: it stayed in the list of its group, where it counted in the limit of the group. ** The end of a request no longer writes back the session group of its persistent session when the request did not change it: it could undo the change made meanwhile by another request of the session (State.set_persistent_data_session_group or unset_persistent_data_session_group), and the session then belonged to a group without being in its list. Nor does it write back a session that the request opened and that another request closed meanwhile, for instance because the group was full. ** The maximum number of persistent tab sessions in a browser session is now the one set for tab sessions (, State.set_default_max_persistent_data_tab_sessions_per_group, 100 by default). The maximum number of sessions in a group applied instead. ** State.Ext.set_persistent_data_cookie_timeout and unset_persistent_data_cookie_timeout now only change the timeout of the cookie. They wrote back the whole cookie read before: they could open a closed session again, or undo a change of its session group. The unset function also removed the cookie from the index of expiration dates, so that it was never collected unless it was used again. ** Changing the global timeout of persistent sessions with ~recompute_expdates:true no longer runs without end with the SQLite backend of Ocsipersist, which moves a row it writes: the cookies are read before being updated. The update no longer writes back the whole cookie either, nor drops it from the index of expiration dates when its date does not change, and it leaves as it is a cookie that changed meanwhile (a request of its session, or a timeout of its own). ** The client reports data that are not a marshalled value with a Failure outside a window too (Node.js, web workers): the message used window.btoa, which raised a ReferenceError there. ** The client reads the long float arrays sent by a big-endian server correctly: the shared values read after them were wrong. ** Lib.Url.encode of the client encodes slashes, + and spaces as the server does: slashes as %2F, + always as %2B, and spaces as + by default or %20 with ~plus:false. URLs built by the client thus encode the slashes of the values of suffix parameters, which the server read as separators. BREAKING for direct callers on the client: slashes were kept, ~plus told whether + is encoded, and spaces were always %20. ** The fragments of URLs and of the actions of forms built by the server encode spaces as %20, as on the client, not +, which is not a space in a fragment. ** Eliom_react.Up: sending an event from the client no longer fails with Failed_request 204 once the server has received it. Its service is an action, which answers without content. ** Raw HTML (Html.F.Unsafe.data and D, Svg.F.Unsafe.data and D) built by the client is parsed as the content of its parent element, which gives the nodes of the server for well-formed markup. The client inserted it as text before. BREAKING: on the client too, its markup is now interpreted and its scripts run, so it must not contain unsanitized user input. As a D node or in reactive content, it must give a single node. ===== 12.1.0 ===== * Compatibility with OCaml 5.5 (Outcometree's Otyp_object replaced open_row with a row field, and out_type gained Otyp_external and Otyp_functor) * Compatibility with js_of_ocaml 6.4 (getElementsByTagName now returns a Dom.collection, and Dom_html gained a `listener` value that shadowed a local binding) ===== 12.0 ===== * Eliom_lib ** Deprecated logging functions were removed (#821) These are: debug_exn, debug, error, error_any, jsdebug * Full WASM support: build system and sending either js or wasm depending on the browser * Use Log instead of Lwt_logs ===== 11.1 ===== * Compatibility with WASM ===== 11.0 ===== * Building Eliom app as executables, with Ocsigen Server as a library, without config file ===== 10.4.1 ===== * Update to OCaml 5.2 (thanks to Kate Deplaix) ===== 10.4.0 (2024-03-22) ===== * Basic client-server distillery template: sqlite is now the default backend * Basic template now has license unlicense * Basic template fixes * Compatibility with Tyxml >= 4.6.0 (by Vincent Laporte) ===== 10.3.1 (2024-02-21) ===== * Fixing Problem with browser navigation https://github.com/ocsigen/eliom/issues/781 ===== 10.3.0 (2024-02-18) ===== * Adding raw events handlers in Eliom_content.Html.F.Raw for server-side only programming ===== 10.2.0 (2023-12-08) ===== * Adding Dune-based basic template client-server.basic ===== 10.1.0 (2023-09-25) ===== * Fix compilation with OCaml 5.1 ===== 10.0 (2022-03-08) ===== * Make Eliom_state.Ext.discard_state more robust ===== 9.0 (2021-10-16) ===== * compatibility with ocsigenserver.5.0.0 (outsourced Ocsipersist) ===== 8.8 (2021-10-05) ===== * rework Eliom_client * more debugging info * restore functions to access uploaded file info ===== 8.6 (2021-07-26) ===== * improvements of history handling and DOM caching ===== 8.5 (2020-10-28) ==== * Compatibility with ocsigenserver 4.0 ===== 6.9 (2019-11-12) ===== * fix scrolling bug: scrolling to top happens before page change * Server functions: log function argument on uncaught exceptions * Compile Eliom libraries with the linkall option ===== 6.8 (2019-09-11) ===== * Use directly Pcre instead of relying on Netstring_pcre * Improved async exception handler * Remove camlp4 syntax * Adapt to OCaml 4.08 * PPX extension: use migrate-parse-tree ===== 6.7 (2018-02-08) ===== * Eliom_client.Page_status: function while_active; ?stop parameter * DOM caching: treat history as linear and keep only reachable pages in cache ===== 6.6 (2018-01-17) ===== * Add missing function Eliom_request_info.get_remote_port * Eliom_client.Page_status.oninactive * Some documentation on DOM caching * Eliom_wrap: fix compilation on 32-bit architectures ===== 6.5 (2018-12-18) ===== * Compatibility with tyxml.4.3.x and js_of_caml.3.3.x ===== 6.4 (2018-12-17) ===== * Compatibility with Lwt 4.x * New configuration option to set html content type * Comet: deactivate when window does not have the focus; deactivate polling when idle * eliom_request_info.in_request_handler * Client-side non-localized parameters * Provide a way to serve global data separately from the initial page ===== 6.3 (2018-02-08) ===== * Compatibility with OCaml 4.06, js_of_ocaml 3.0 and Lwt 3.0 * DOM caching (preview) * Various small fixes and improvements ===== 6.2 (2017-02-07) ===== * Implement Eliom_client.onchangepage * Fix URL-related bugs arising in mobile apps ===== 6.1 (2016-12-20) ===== * Remove redundant dependency on calendar * Permit client routing to "./" * -y parameter for eliom-distillery (do not ask) * Eliom_client: do not execute onload after OCaml services * Permit suffix params in Eliom_service.create_attached_post ===== 6.0 (2016-12-08) ===== * Improve Eliom_service and Eliom_registration APIs using GADTs * Implement client-side services, useful for mobile apps. This includes ** client-side service registration (Eliom_registration) ** client-side service routing (Eliom_client.change_page_uri) * Transition to PPX internally * Compatibility with ** OCaml 4.03.0 and 4.04.0 ** Js_of_ocaml 2.8.2 and newer ** TyXML 4.0 and newer * Various bugfixes and improvements ===== 5.0 (2016-01-28) ===== * Add Eliom_shared and server-side Eliom_content.{Html5,Svg}.R modules * Add PPX syntax extension * Clean-up form APIs, now available under Eliom_content.Html5.{D,F}.Form * Patches to significantly reduce the size of request data * Compatibility with TyXML 3.6, Js_of_ocaml 2.7, and reactiveData 0.2 * Various bugfixes and enhancements ===== 4.2 (2015-07-21) ===== * Add Manip.children, to get the html children of an element. * Simplify Html5 and Svg signatures using tyxml's signature functors. * Various logging improvements, in particular in Eliom_client. * Fix eliomdep's exit code when calling option "-sort". * Fix #168: call_ocaml_service always sends boolean true. * Makes server function return types covariant. * Restore compatibility with ocsigenserver 2.6 and lwt 2.4.7. * Various bugfixes and wiki updates. ===== 4.1 (2014-10-01) ===== * Compatibility with js_of_ocaml-2.5 and tyxml-3.3.0 * Improvements: ** Simplify typing of services ** Use GADT to encode service parameters (Eliom_parameter) Eliom need OCaml 4.00 at least. ** bugfixes for service parameters ** Various bugfixes and enhancement ===== 4.0 (2014-05) ===== * Main new features: ** Reactive DOM elements (thanks to a contribution by besport.com) ** PUT and DELETE services for RESTful Eliom Applications (Contribution by Domoco) ** EXPERIMENTAL: Mobile apps with Eliom. By making it possible to start the application from client-side. ** Documentation improvements * Improvements: ** Improvements in typing of services (Contribution by Jacques-Pascal Deplaix) ** Filtering data from Eliom buses ** "caml" in value or type names now replaced by "OCaml" everywhere ** New module {{{Eliom_registration.File_ct}}} to make easier to send files with their content type ** Now possible to define services in shared sections ** Adding function {{{Eliom_client.change_url}}} to change the URL without doing a request ** Adding function {{{Eliom_service.attach_coservice'}}} to attach a non-attached coservice to an URL ** Improving comet configurations: now possible to stay idle instead of being completely inactive ** Now using defaultprotocol option (from ocsigenserver) to compute URLs ** The default expiration date for cookies on client side is now 10 years ** Now possible to send files in {{{Eliom_client.call_ocaml_service}}} ** Various additions and bugfixes in {{{Manip}}}, {{{Eliom_request_info}}}, {{{Eliom_content.html5}}} (events) (contributions by besport.com) ** eliom-destillery renamed into eliom-distillery ** Templates for eliom-distillery ** New programs: eliomdoc and eliompp ** Ocamlbuild package ** Various bugfixes And many other things (see git commits) ===== 3.0.0 (2012-12-10) ===== * Language ** Generalized client values in server code ** Injections into client sections * Tools ** Added eliom-destillery for generating project scaffolds ** Support Eliom interface files (.eliomi) in eliomc, eliomdep ** eliomdep: Generate dependencies between eliom-modules ** eliomc: infer only with option -infer, drop option -noinfer ** eliomc: Basic support for -i on eliom-files ** eliom{c,dep,opt},js_of_eliom: -dump to output the intermediate code ** eliomc,js_of_eliom: always open Eliom_pervasives in eliom files * API ** Eliom_pervasives.server_function to easily access the from the client ** Get current state of a scope ** Module to access values of Eliom references in external states (Eliom_state.Ext) ** Scope names are now named scope hierarchies ** Iterate the scope hierarchy (group > session > client > request) ** Adding Eliom_parameter.(type_checker, neopt) ** Add functions to insert html5 in atom feeds ** Eliom_tools.{F,D}.html to ease creation of head-tag ** Eliom_tools.wrap_handler as an easy alernative to Eliom_registration.Customize ** Test for initial request of a client on the server * Changed server behaviour ** Eliom_state.discard_everything now also discards request state ** Don't send nodes as data when they are part of the document * Changed client behaviour ** Show progress cursor during navigation with change_page ** Improved error messages ** Fail on the client when a [server_function] or call_caml_service fails on the server * Bugfixes ** Allow % for injections directly after parentheses * Support dropped for ** Xhtml ** OCamlDuce ** Eliom_compatibility_2_1 * A myriade of bugfixes ===== 2.2.2 (2012-06-11) ===== * Fix (re-disable) generation of API doc for ocamlduce modules ===== 2.2.1 (2012-06-07) ===== Addendum to the great renaming * Eliom_cookies -> Eliom_cookie * Eliom_comet.Channels -> Eliom_comet.Channel ===== 2.2 (2012-06-02) ===== The great renaming: Make Eliom's API more coherent * Dropped Eliom_pervasives, split into ** Eliom_lib (extension of stdlib) ** Eliom_content (content creation) * Moved all Html5,Xhtml content function to Eliom_content.{Html5,Xhtml} ** {HTML5,SVG,XHTML}.M -> Eliom_content.{Html5,Svg,Xhtml}.F ** {HTML5,SVG,XHTML}.DOM -> Eliom_content.{Html5,Svg,Xhtml}.D ** Eliom_output.{Html5,Xhtml}: form functions to Eliom_content.{Html5,Xhtml} ** Eliom_client.Html5 -> Eliom_content.Html5.To_dom ** Eliom_dom -> Eliom_content.Html5.Manip ** HTML5.of_element -> Eliom_content.Html5.Of_dom.of_element * Removed default implementations in Eliom_content.{Html5,Svg,Xhtml} (was inclusion of DOM) * Rename Eliom_output to Eliom_registration * Rename Eliom_registration.Eliom_appl to Eliom_registration.App * Conform naming conventions for modules (singular, lower-case) ** XML -> Xml ** SVG -> Svg ** XML_types -> Xml_types ** XHTML_types -> Xhtml_types ** HTML5_types -> Html5_types ** Eliom_services -> Eliom_service ** Eliom_parameters -> Eliom_parameter ** Eliom_references -> Eliom_reference ** Eliom_extensions -> Eliom_extension * Approximating compatibility module for Eliom 2.1: Eliom_compatibility_2_1 ===== 2.1.1 (2012-03-20) ===== * Server: Add Eliom references of scope site * Server: Add an non-Lwt interface to volatile Eliom references * Client: Add an option to restrict usage of XHR. * Bugfixes: ** Client: More robust and portable history handling ** Client: More robust CSS preloading (change_page) ** Client: Better compatibility with Opera ===== 2.1.0 (2012-02-24) ===== * Page loading rewritten. ** We do not traverse the HTML tree anymore for retrieving links and putting events handlers, it use querySelectorAll instead. (with a fallback for older browsers) *** We do not send a sparse tree along the page anymore. *** It is faster and more resilient to ugly browser plugins ** Add css loading optimisations: It fetch the css included using @include with XHR before changing page and construct only one concatenated css. It avoids page blinking when the css change and is faster (browsers tend to render the page once per css). ** Unwrapping hand rewritten in js. ** And a lot of other optimisations. * Rework of unique nodes: ** Introduce new lightweight 'unique' node of scope request, a.k.a. DOM nodes: use it through HTML5.DOM.{div,...} or its alias HTML5.{div,...}. ** To create unique node of scope application, the function 'HTML5.M.unique ?copy' has been renamed 'HTML5.create_global_elt ?id' ** Abstract id for application node are created with "HTML.new_global_elt_id" ** Node representation now differs between the client and the server. They are unwrapped on the client to simplify the XML representation: "unique" node that have already a "Javascript DOM representation" only contains a reference to the DOM representation. * Server API Changes: ** Add Eliom_state.get_*_session_group_size to know the number of session in a session group ** Parameters of type any can't be suffixes (semantic problem) ** Add Eliom_comet.wait_timeout to notify when a client isn't active ** Allow services to setup "Cache-policy: max-age" with Text, CssText and Files modules. ** Eliom_state.discard and discard_data now accept scope request. * Client API Changes: ** add an Eliom_dom module provinding imperative function on unique HTML5.elt. (for instance {{{appendChild: ?before:'a elt -> 'b elt -> 'c elt -> unit}}}). ** HTML5.M.a_on{click,...} functions directly expect a function as parameter (XML.event_handler_of_function isn't required anymore). ** Eliom_comet: configuration option for time until timeout after the focus is lost ** Handling wrapping of int32 type. ** Onload event handlers on HTML elements are executed when they are converted to DOM (using Eliom_client.of_ functions). This allows them to be added to nodes not sent in the page. ** Calls to {{{Eliom_services.onload}}} are taken into account for services sending caml values. The handlers are executed when the call to {{{Eliom_client.caml_call_service}}} terminates. * Eliom syntax: ** Event handlers can now access the current event using the _ev variable inside {{ ... }} typed according to the attribute. ** Allow modules to be used inside client expr {{ ... }} and client_expr {{ ... }} to be used inside modules ** Add -ppopt option to eliomc * And a lot of bugfixes. ===== 2.0.2 (2001-11-30) ===== * Compatibility with js_of_ocaml-1.0.8 and tyxml-2.0.1 * API Changes: ** Eliom_output.Redirection: use 302 as default and introduce abstract nome for all the 30x HTTP code ** Eliom_output.Customize: remove unrequired Functor parameters. * Delayed URl computation: this allows relative links to be created outside of service handler. * Client: do not ignore "onload" events attached on Dom elements other than window. * Bugfixes: ** Client: do not execute change_page_uri when the middle button or any modifier key is pressed. ** Client: update correctly the location when changing page with forms. ** Server: displaying better dynlink error messages. ** Syntax extension: avoid infinite loop while parsing first-order module expression ** Eliom_parameters: fixing wrong parameter names for list of list ** Eliom_parameters: fixing bug causing stack overflow when lists parameter names were wrong ** Fixing bug with non-localized parameters and service not keeping non-attached params ** Eliom_comet: stateless channels can be registered multiple times (close #220) ===== 2.0.1 (2011-09-28) ===== * Bugfixes in eliom appl.: ** Preload css when changing page to avoid a disgraceful "flash" effect ** Use to preserve links in unique node when changing page ** Fragment in URL aren't ignored anymore ** Proper exception handling in eliomc, js_of_eliom, ... ** Display a correct URL after submitting a
===== 2.0 (2011-09-20) ===== * Bugfixes: ** Correct handling of HTTP redirections hidden by XHR ** Fix links from http to https on client application ===== 2.0-rc2 (2011-09-06) ===== * Feature: ** api history: when the api history is available, application URLs are more readable (no more {{{#!}}}) * Bugfixes: ** fix browser compatibility: it should work with Firefox (>= 3.0), Chrome (all recent version we tested), Safari 5, Opera (tested 11.51), Internet explorer (9, ie 8 almost work) ** in forms declared outside of the sp's scope, hrefs were incorrect: url calculation is now done for each request ** the function {{{Eliom_client.caml_call_service}}} was broken with some kind of services ** application cookies are now always sent ** fix incorrect sharing of type variables in the syntax extension (thanks to William Le Ferrand) ** 404 and 403 errors are not dropped by applications anymore (This fix is partial: when the page content is application content, this still does not work when an exception handler returns something else) ** Fix problems with url generation for non-attached coservices inside an application ** tail recursive marshalling and demarshalling: no more limit on the depth of data sent along the page ** Fix problems with redirection and action with `NoReload exiting the application ** Handle correctly 204 code in application (do nothing with change page, fail with caml_call_service) ** Fix escape character '>': problem with strings containing "]]>" ===== 2.0-rc1 (2011-07-15) ===== * Eliom_client.change_page type now correctly forbid to call it on non-eliom application services * Stateless implementation of comet channels * Scope and state names parameters of functions are now fused in one parameter (called scope) * Change the type of 'send' functions: forbid use of incompatible output with Eliom_output.Any together. * Change the format of page loaded by an application: all pages are sent in HTML5 format. (first answers were in HTML5 subsequent were marshalled caml tree) * XML representation is now shared by client and server: conversion to Dom nodes is made by Eliom_client.Html5.of_ functions * Remove the need for an application container: application pages are now classical HTML5 pages. * Add Eliom_pervasives.{HTML5/XML/SVG}.unique function to declare XML node handled "by reference" * Fix ocamldoc generation with Eliom_output * Eliom_appl are now stateless if no data is stored in session * Allow dynamic wrapping with values to be sent to client with caml services and comet channel * Add Eliom_react.S: server to client React signals * Add lazy site values: lazy evaluated one time per site * Option to compile without preemptive threads * And lots of simplifications and bug fixes ===== 1.91 (2011-04-08) ===== * Split the ocsigen package in three : tyxml, ocsigenserver and eliom * Rename into eliom * It's now possible to set a //priority// on services registered on the same path, to choose in which order Eliom will try them. * New implementation of internal application forms with formData when available * New build system for eliom application * No type restriction in value sent from the server to the client ===== 1.90 ===== * New module {{{Eliom_client}}} for client/server Eliom programs using js_of_ocaml. * Eliom client: calling a service from client side code. * Eliom: Services taking Caml values as parameters. * Eliom: services sending Caml values. * Eliom: new implementation of forms and links to be compatible with client side programs. * Eliom: sp parameter has been removed (now using Lwt's thread storage) * Eliom: {{{Eliom_predefmod}}} renamed {{{Eliom_output}}} * Eliom: New module {{{Eliom_output.Customize}}} to create your own register functions from another registration module * Eliom: Module {{{Eliom_sessions}}} replaced by {{{Eliom_state}}}, {{{Eliom_request_info}}} and {{{Eliom_config}}}. * Eliom: new implementation of user cookies. * Eliom: Client process cookies. Like usual browser cookies but for one client side process. * Eliom: Client process server side state data. Like session data but for one client side process. * Eliom: Client process session services. * Eliom: Session group data. Like session data but for all sessions in a session group. * Eliom: Session group services. * Eliom: session replaced by a more general concept of "server side state". States have a scope: client process, session or group of sessions. * Eliom: session tables and request cache now deprecated, replaced by //Eliom references// * Eliom client: Possible to call another service without stopping the client side program, with bookmark support and back button support. * New extension Comet to allow server -> client communication. * Eliom: client/server communication channels. * Eliom: client/server reactive programming using React. * Eliom client: syntax extension for separating client and server code. * Eliom: New module Eliom_output.Eliom_appl for registering pages that belong to the same Eliom application. * Eliom client: syntax extension and wrapping/unwrapping mechanism to access server side values in client side code. * Eliom client: Relinking the DOM on client side after loading a (portion of) page. This allows nodes created on server side to be directly used in client side code. * Eliom client: XHR redirections for Eliom applications. * Eliom: safe unmarshaling of caml values sent by client side programs * Xhtml: Xhtml5 support * Atom module and Pubsubhubbub * OpenID support * SVG module * Documentation: New tutorial * Documentation: New Eliom manual * //and many other things ...// ===== 1.3.4 ===== * Eliom: Now supporting list of lists in service parameters ===== 1.3.3 (2010-06-13) ===== * Eliom: Fix some typos in Eliom's tutorial stylesheet * Server: Fix usage of {{{accept_n}}} to avoid file descriptor leakage * XHTML: Adding missing elements and attributes in XHTML.M * Cleaning Ocsigen_cache * Eliom: Fixing actions with uploads ===== 1.3.2 (2010-04-30) ===== * Add dummy findlib packages ocsigen.xhtml*, that depend on ocsigen_xhtml*, for compatibility with previous versions. These packages might be removed in a future (major) release. * Port to Lwt 2.1.0 ===== 1.3.1 (2010-04-23) ===== * Split out ocsigen_xhtml findlib package * Configuration file: when no protocol is specified in {{{}}}, listen on IPv6 (if possible) and IPv4 (always) ===== 1.3.0 (2010-01-22) ===== * Server: Each request now has a polymorphic data table (called //request cache//), where you can store the data you want to keep during the whole page generation. * Eliom: actions now return {{{()}}}. Use the request cache to send information to fallbacks. * Eliom: CSRF-safe coservices * Eliom: the number of sessions without group by IP address is now limited * Eliom: efficient implementation of limitation of sessions by groups (or now IP) for large limits * Eliom: the number of anonymous coservices by session is now limited * Eliom: the number of anonymous coservices without session by IP address is now limited * Eliom: now possible to unregister services * Eliom: New (very) experimental module {{{Eliom_obrowser}}} to use Eliom with Obrowser * Eliom: Now possible to have constant parts in suffixes to allow URLS like {{{/param1/something/param2}}} * Eliom: services with optional suffixes * Eliom: form towards a service with suffix: it is now possible to choose whether you want the redirection towards the suffix form or not * Eliom: lists and sets in suffixes * Eliom: Now possible to create services sending custom HTTP header values or customizing the content-type * Eliom: New notion: "Non localized parameters". Can be sent to any service. * Eliom: changing the order of parameters for user type form widgets * Eliom: changing the order of parameters for user type form widgets * Eliom: Eliom_tools.menu and hierarchical_menu now compare the URL strings (was: compare the service) * Eliom: textarea now take a string (was pcdata) * Eliom: The type of the iterator for lists in parameters has changed * Eliom: New options in configuration file to set session timeouts * Server: now possible to give the config file name to reload server command * Server: now possible to do a "graceful shutdown" of the server using the "shutdown" server command * Server: now possible to add custom commands for the command pipe * Server: EXPERIMENTAL now possible to observe HTTP headers before sending the result * Xhtmlpp: the parsing now fails if a quotation for an Xhtml element contains superfluous elements. (This can cause the parsing of previously incorrect code to fail) * Staticmod/Eliom: attempting to access a file whose name contains a NULL character will result in a 403. * Server: HTTP headers containing newlines are now properly escaped. * Server: correct missing xmlns in Xhtml DTD * Server: now send last-modified and etag headers when returning a 403 * Server: Now accepting several requests at a time (as explained in "Accept()able strategies" by Tim Brecht & all) * Rewritemod: more rewriting possibilities (still very basic) * Eliom menus are now more robust when finding which item is active * Fixed handling of incorrectly-sized multipart requests. Thanks to Mauricio Fernandez for noticing the bug * Upload directory and maximum file size can now be configured on a per-site basis * Renamed the field of Ocsigen_http_frame.t * Javascript events support in Xhtml.M ; Thanks to john @ 5070.info for the patch ===== 1.2.2 (2009-10-17) ===== * Add react and lwt.unix to the list of built-in findlib packages ===== 1.2.1 (2009-09-26) ===== * Lwt 2.0 compatibility: ** Adapt to Lwt.t/Lwt.u splitting ** fix Makefile to deal with lwt.unix findlib package * Fix ocsipersist-dbm Makefile * Fix for pcre-ocaml 6.0.0 * Fix typo regarding --stubdir in configure script ===== 1.2.0 (2009-03-25) ===== * Native code version now compiled by default * Now possible to link extensions and Eliom modules statically, for example to use a native code server on platforms where native dynlink is not supported * Server: Partial requests implemented (Range HTTP header) * Build C stubs into a shared library so that bytecode executables may be not linked in custom mode; new {{{--stubdir}}} option in {{{configure}}} script * Eliom: non-attached services now called "named non-attached coservices" and created using {{{Eliom_services.new_coservice'}}} with the optional {{{name}}} parameter * Eliom: now possible to create named attached coservices using the optional {{{name}}} parameter * Eliom: now possible to write libraries for Eliom sites, loaded inside {{{}}}, but not generating any page * Eliom and server: EXPERIMENTAL now possible to make extensions that can use Eliom's data * XHTML.M's pretty printer: now possible to set the DOCTYPE manually * Eliom: now possible to set manually the DOCTYPE when registering an XHTML.M service * Redirectmod and Revproxy: now possible to do more complex rewriting * Accesscontrol: add support for {{{}}} and {{{}}} conditions * Config file: {{{aliases}}} attribute now called {{{hostfilter}}} * Revproxy and Redirectmod: now possible to filter on server, port and protocol * New extension extendconfiguration to allow dynamic changes in the configuration (mimetypes, charsets, followsymnlink, directory listing, ...) * Server: new module {{{LocalFiles}}} factoring the common parts for sending static files (with Eliom and staticmod for example), while checking that the files can safely be sent. * Now possible to use XHTML pretty printers without Ocsigen, using the {{{xhtmlpretty.cma}}} library * Add {{{Ocsigen_lib.register_exn_printer}}}, better error messages * Now possible to use the same configuration file in native code and in bytecode (.cmo/.cma filenames are internally translated to .cmxs) * Signature of Ocsigen_extensions.register_extension is now more complete and more lightweight * Userconf: the options set in the local .userconf file are kept in the enclosing {{{}}} tag * Server: possibility to ignore or to supply an alternative command-line * Ocsigen_http_client: timeout when the distant server does not exists * OCaml versions < 3.10 are not supported anymore * Extensions are now much more strict w.r.t. the syntax of configuration files * Staticmod: accessing a directory for which indexing is disallowed returns an error 404 (instead of a 403 previously) ===== 1.1.0 (2008-07-15) ===== * Lwt removed (now distributed separately) * {{{XHTML.M}}} pretty printer: fixing pretty printing of empty tags (for browser compatibility) * Eliom_duce: New pretty printer for XHTML fixing pretty printing of empty tags * Eliom: secure sessions, secure services, (absolute) https links/forms, and using secure cookies * Eliom: Adding special "void action", without any parameters * Eliom: {{{Eliom_predefmod.Redirections}}} now called {{{Eliom_predefmod.String_redirection}}}, and adding new module {{{Eliom_predefmod.Redirection}}} that use GET services without parameters as data type. * Eliom and XHTML.M: Small changes of types in interfaces * Eliom: New session ID generator * Eliom: Adding types {{{int32}}} and {{{int64}}} for parameters and forms * Eliom: Adding functions {{{lwt_get_form}}} and {{{lwt_post_form}}} for creating forms using cooperative functions * Eliom and Staticmod: now possible to give GET parameters to static pages * Eliom: Bugfix in Makefiles for native code version * Eliom forms: Adding missing types in interfaces * Eliom_tools: current page is now optional in menus * Userconf and Eliom: there was a bug when loading both Eliom and Userconf together * Reverse Proxy: Now sending content length when available * Web server: The default content-type is now {{{application/octet-stream}}} * Creating and installing a cma file for all Ocsigen libraries not installed elsewhere * Ocsipersist-dbm: fixing bug when removing data * Deflatemod: fixing memory leak * And small bugfixes in XHTML.M, Eliom, ... ===== 1.0.0 (2008-04-01) ===== * Config file: findlib integration * Eliom and Ocsigen: changing namespace convention for modules * Access control: simplification of config file syntax * Eliom: Allowing (module dependent) parameters for registration functions * New xhtml output without pretty printing * Web server: Bugfix in HTTP/1.0 with keep-alive * Reverse proxy: Bugfix GET parameters were wrong * Reverse proxy: Bugfix memory consumption when the connection was closed by client ===== 0.99.5 (2008-01-11) ===== * Revproxy: pipelining of requests * Access control: simplification, generalization of filters and syntax changes in config file * Eliom: EXPERIMENTAL session groups * Eliom: non-attached services * Eliomduce: new functor {{{SubXhtml}}} for creating registration modules * Eliomduce: new module Eliomducetools with same features as Eliomtools, but for Eliomduce * Web server: now possible to split the configuration file into several files using the {{{}}} option. * Web server: now possible to have {{{}}} option inside another {{{}}} in configuration files, and the the first one is optional * Web server: EXPERIMENTAL user configuration files, with restricted possibilities (for security reasons) * Web server: IPv6 support * Deflatemod: now possible to filter on file extensions * Eliom: new option to keep GET non-attached parameters or not when doing a POST form towards a non-attached coservice. * Eliom: bugfix path of session cookies * Eliom: bugfix POST non-attached coservices called from a page with non-attached GET parameters were not found. * Lwt: now catching exceptions raised after timeouts * Cgimod: bufixes in path handling * Web server: bugfix - some files were not closed ===== 0.99.4 (2007-11-21) ===== * Ocsigen: Changes in the extension mechanism. The extensions are not tried in the order in which they are loaded any more, but in the order in which the options are specified for each site in the configuration file. * New experimental extension: access control * A few small enhancements ** Eliom: internal cookie management rewritten (+ bugfix) ** Eliom: Small changes in function names ** Eliom: now retry all extensions after actions (not only Eliom) ** Eliom: cleaning {{{Eliommod}}} interface ** Ocsigen server: Internal changes in server (removing "send" functions, debug messages lazier) ** Lwt: Adding a few functions in {{{Lwt_chan}}} interface ** Staticmod: Allowing default error pages for HTTP errors to be customized ** Ocsipersist (dbm and sqlite): better handling of database errors ** XHTML: New pretty printer for xhtml using streams (up to 15% speedup on requests) ** XHTML: Allowing any value for {{{}}} rel attribute (for example {{{shortcut icon}}}). ===== 0.99.3 (2007-11-07) ===== * Ocsigen: New module Deflatemod to compress data before sending to the browser. * Ocsigen: EXPERIMENTAL - New module Revproxy (reverse proxy). * Eliom: New session mechanism, with the ability to name the sessions and thus have several sessions for the same site. * Eliom: Now possible to have one site with session inside a subdirectory of another one. * Lwt: New module {{{Lwt_timeout}}} to implement timeouts, new module {{{Lwt_chan}}}, new module {{{Lwt_mutex}}}, new function {{{Lwt_unix.abort}}} to make all threads waiting on a file descriptor abort with an exception. * Ocsigen: New implementation of lots of Web server internals. Better management of Ocsigen's streams, file descriptors, exceptions, timeouts ... * A lot of enhancements and bug fixes: ** Eliom: Single {{{}}} in forms, by Stéphane Dalmas * EXPERIMENTAL: The Web server is now extensible. It means that you can add modules (like Apache modules) for generating pages, filters of requests, extensions of config files. For now there are two modules, one for static pages, and one for dynamic pages. The only changes for users is that they need to dynlink staticmod.cmo and ocsigenmod.cma from the configuration file. The syntax of config file for modules and staticdir also changed. * It is now possible to specify the encoding of characters for each sub-site. * Now usable with Ocamlnet 2.2 or 1.1.2. * EXPERIMENTAL: If OCamlDuce is installed on your system, you can now use it to do the type-checking of your pages (see the documentation). Warning: This is broken with OCamlDuce 3.09.2 patch level 2. You need at least OCamlDuce 3.09.3 patch level 1. * Removing Ocsimore from the default distribution. That version of Ocsimore is not supported anymore. Ocsimore has been rewritten from scratch by Piero Furiesi. ===== 0.5.1 (2006-12-14) ===== * Bugfix Konqueror: Multipart forms with now work correctly with Konqueror * Bugfix Internet Explorer: getting around a bug of Internet Explorer while displaying page * Bugfix NetBSD: Makefile * Bugfix Debian for HPPA, Mips, Alpha: Makefile * Bugfix: preemptive.cmi was missing in the installation directory * Adding manpage (S. Mimram) * Adding logrotate configuration * Daemon mode: adding setsid and redirect stdout/stderr to /dev/null. Closing stdin. ===== 0.5.0 (2006-11-23) ===== * HTTP 1.1 improved (HEAD, ETag, keep-alive implemented, If-Modified-Since, ...) * HTTPS support * Pipelining of requests * Server can listen on several ports * Multiple servers: you can now define several servers in the config file. * Virtual hosts: filtering on hostnames/ports (with wildcards) * Asynchronous file upload with multipart support * Large file transfer improved. * MIME types are now parsed from a file * Changes in the syntax of config file * Accessors for server parameters. Use ({{{get_user_agent sp}}}) instead of {{{sp.user_agent}}}. * Page generation is now using {{{Lwt}}} cooperative threads, to make it possible the generation of several pages at the same time. Practically, add {{{Lwt.return}}} before the page you want to send, and use cooperative input/output functions. * Typing errors of parameters are now catchable. * {{{static_dir}}} is now a function * Most of global references have been removed. You now need to give sp as parameter to {{{register_for_session}}}, {{{static_dir}}}, {{{close_session}}}, etc. * Links and forms now take {{{server_params}}} instead of {{{current_url}}} ({{{sp}}} is shorter than {{{sp.current_url}}}) * EXPERIMENTAL: Use of preemptive threads for non cooperative libraries ({{{detach}}} function). * EXPERIMENTAL: The {{{Ocsigen}}} module now contains a functor {{{Make}}} to allows the use of several ways of generating XHTML. The default way (using {{{XHTML.M}}} or the syntax extension) can be used by doing {{{open Ocsigen.Xhtml}}}. There is also an untyped xhtml generation module called {{{Ocsigen.Text}}}. * EXPERIMENTAL: extension of forms. * Reorganisation of the code * Bugfixes in makefiles * Bugfix: escaping of strings in xhtml with syntax extension (thanks to David Mentre) ===== 0.4.0 (2006-06-06) ===== * Full reimplementation of the core using Generalized Algebraic Data Types, * {{{_int}}}, {{{_string}}}, etc. are now called {{{int}}}, {{{string}}}, etc. * The type {{{_http_params}}} is now called {{{server_params}}}, * Services functions now all take 3 parameters, one for server parameters, one for GET parameters, and one for POST parameters. Note that {{{**}}} is used to create **pairs** and not tuples. * The {{{a}}} and {{{post_form}}} functions now take a fix number of parameters, corresponding to GET parameters. * //URLs// are now called //services//, * //state URLs// are now called //auxiliary services//, * {{{register_post_url}}} does not exist anymore. use {{{register_service}}} instead (idem for all other {{{register_post_*}}} functions). * Changes for prefix URLs * Small changes for actions * EXPERIMENTAL: sums, bool and list types for services and forms * small bugfixes ===== 0.3.27 (2006-04-27) ===== * Change the way to get server parameters ===== 0.3.26 ===== * Load unsafe modules * Other small changes ===== 0.3.25-2 (2006-02-24) ===== * Small bugfix for 64 bits processors * bugfix for static files * {{{action_link}}} is now called {{{action_a}}} ===== 0.3.24 (2006-02-07) ===== * More documentation * Change types {{{internal_url}}} and {{{external_service}}} to use polymorphic variants ===== 0.3.23 (2006-02-07) ===== * Better handling of static files and "403 Forbidden" message eliom-13.0.0/CODE_OF_CONDUCT.md000066400000000000000000000007741527170563500155220ustar00rootroot00000000000000# Code of Conduct This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md). # Enforcement This project follows the OCaml Code of Conduct [enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement). To report any violations, please contact Jérôme Vouillon, Raphael Proust, Vincent Balat, Hugo Heuzard and Gabriel Radanne at (or some of them individually). eliom-13.0.0/COPYING000066400000000000000000000654371527170563500137650ustar00rootroot00000000000000This program is released under the LGPL version 2.1 (see the text below) with the additional exemption that compiling, linking, and/or using OpenSSL is allowed. As a special exception to the GNU Library General Public License, you may also link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library, or a modified version of the Library that is distributed under the conditions defined in clause 3 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! eliom-13.0.0/LICENSE000066400000000000000000000004131527170563500137160ustar00rootroot00000000000000The Ocsigen application core, and other portions of the official Ocsigen distribution not explicitly licensed otherwise, are licensed under the GNU LESSER GENERAL PUBLIC LICENSE with openssl linking exception -- see the 'COPYING' file in this directory for details. eliom-13.0.0/Makefile000066400000000000000000000007001527170563500143500ustar00rootroot00000000000000### Building .PHONY: all all: dune build ### Cleaning ### .PHONY: clean distclean clean: dune clean distclean: clean -find ./ -name "*\#*" | xargs rm -f ### Installation #### .PHONY: install uninstall reinstall install uninstall: eliom.install ifneq ($(PREFIX),) opam-installer --$@ --prefix $(PREFIX) eliom.install else @echo you must provide a prefix with : make PREFIX=myprefix $@ endif reinstall: ${MAKE} uninstall ${MAKE} install eliom-13.0.0/README.doc000066400000000000000000000004351527170563500143410ustar00rootroot00000000000000To update the API documentation: make doccp git checkout wikidoc rm -rf doc/dev/api cp -r _build/doc/dev/api doc/dev/api git add doc/dev/api git commit To update manual: Edit files in doc/dev/manual To create a new version: cp -a doc/dev doc/ Then commit and push on Github eliom-13.0.0/README.md000066400000000000000000000072741527170563500142040ustar00rootroot00000000000000# Eliom - the full-stack OCaml Web and mobile framework Eliom is a framework for building client/server Web and mobile applications in OCaml. It can be used both as a traditional server-side Web framework or to implement complex client-server applications. Eliom transforms OCaml into a multi-tier language, making it possible to implement both the server and client parts of a Web and mobile app as a single program. This simplifies a lot the communication between server and client. Applications can run on any Web browser or mobile device (iOS, Android), saving from the need to develop one version for each platform. Eliom has support for reactive pages (generated on server or client), advanced session mechanism, server to client communication, continuation based Web programming, etc. Eliom is part of the [Ocsigen project][ocsigen]. ## Installation Instructions ``` opam install eliom ``` ## Getting started Defining a service on path `/foo`, taking any GET parameters: ```ocaml let myservice = Eliom.Service.create ~path:(Eliom.Service.Path ["foo"]) ~meth:(Eliom.Service.Get (Eliom.Parameter.any)) () let () = Eliom.Registration.Html.register ~service:myservice (fun get_params () -> Lwt.return Eliom.Content.Html.F.(html (head (title (txt ""))) (body [h1 [txt "Hello"]]))) ``` Inserting a link towards that service, with parameters: ```ocaml Eliom.Content.Html.D.a ~service:myservice [txt "Home"] [("param1", "v1"); ("param2", "v2")] ``` Event handlers are written in OCaml: ```ocaml div ~a:[a_onclick [%client (fun ev -> ... )]] [ ... ] ``` The client-side and server sides are written as a single program: ```ocaml let%server a = ... (* code for the server part of the application *) let%client b = ... (* code for the client part of the application *) let%shared c = ... (* code that will be included in both parts *) ``` Using a server-side value in client-side code: ```ocaml let%server a = ... let%client f () = print_endline ~%a ; (* print in browser console *) ... ``` Calling a server function from the client program: ```ocaml let%rpc f (x : int) : string Lwt.t = ... (* server-side code *) let%client () = let%lwt r = f 4 in ... ``` Saving session data on the server using Eliom references: ```ocaml let%server r = Eliom.Reference.eref ~scope:Eliom.Common.default_session_scope 0 let%server f () = let%lwt v = Eliom.Reference.get r in Eliom.Reference.set r (v + 1); ... ``` Where scope can be: * `Eliom.Common.default_session_scope` (different value for each browser), * `Eliom.Common.default_process_scope` (different value for each tab), * `Eliom.Common.default_group_scope` (different value for each user), * `Eliom.Common.site_scope` (value for the whole site), * `Eliom.Common.global_scope` (global value for the whole server). Eliom references are persistent if you add `~persistent:(name, json_codec)` to function `Eliom.Reference.eref`. Their values are then stored with Ocsipersist, whose database location must be configured. ## Learning Eliom More documentation [here](https://ocsigen.org/tuto/latest/manual/basics). Write your first Web and mobile application with Eliom using [Ocsigen Start](https://ocsigen.org/ocsigen-start) ## Authors * Vincent Balat * Jérôme Vouillon * Grégoire Henry * Pierre Chambart * Benedikt Becker * Vasilis Papavasileiou * Boris Yakobowski * Hugo Heuzard * Raphaël Proust * Jan Rochel * Idir Lankri * Stéphane Glondu * Gabriel Radanne * Gabriel Kerneis * Denis Berthod * Jaap Boender * Simon Castellan * Mauricio Fernandez * Archibald Pontier * Simon Castellan * Kate Deplaix [ocsigen]: https://www.ocsigen.org/ [main documentation page]: https://ocsigen.org/tuto/latest/manual/basics eliom-13.0.0/doc/000077500000000000000000000000001527170563500134605ustar00rootroot00000000000000eliom-13.0.0/doc/README.md000066400000000000000000000101331527170563500147350ustar00rootroot00000000000000# How the Eliom documentation is generated The Eliom documentation published at is built with **odoc** and themed with the Ocsigen site chrome by [**wodoc**](https://github.com/ocsigen/wodoc) (an odoc driver). The same odoc sources are also what ocaml.org renders. Eliom is a **client/server** project: it ships its server and client APIs as two libraries of the same package (`eliom.server` / `eliom.client`) with the **same module names**, so `dune build @doc` collides. The API is therefore built with `odoc_driver eliom --remap` (the engine ocaml.org uses) on the **installed** package — i.e. the documented version is whatever the build switch has installed. ## Sources | What | Where | Format | |---|---|---| | Manual | the `.mld` files of `doc/` and its subdirectories, installed with their path by `(documentation)` (see [`doc/dune`](dune)), built with the API by odoc_driver | odoc pages | | Manual tree | the subdirectories of `doc/` and their `index.mld` (`@children_order`, `@toc_status`): the same tree on ocaml.org and in the left column (wodoc `(page-tree)`) | odoc pages | | Server / client API | `doc/server.indexdoc` / `doc/client.indexdoc` (curated module index) | odoc index | | API (`.mli`) | the installed `eliom` package | odoc comments | | Site configuration | [`doc/wodoc`](wodoc) | wodoc config (S-expression) | | Old manual URLs | [`doc/redirects/`](redirects), copied into each version by `(static-copy …)` in `doc/wodoc` | HTML redirects | The whole site — per-side API navs, the client/server switch, the body colour, the shared manual nav, and the rewriting of sibling Ocsigen projects' cross-refs to relative links — is declared in [`doc/wodoc`](wodoc) and produced by a single `wodoc build`. There is **no `build.sh`** and no Python. ## Build `wodoc build` documents the **installed** `eliom`, so install it first (from the ref you want to document) in a switch that also has `odoc_driver` and `wodoc`: ``` opam install ./eliom.opam # the version to document opam install wodoc # the odoc driver / theming wodoc build --config doc/wodoc --label dev --out _doc-site/dev \ --menu https://ocsigen.org/doc/menu.html ``` `wodoc build` runs `odoc_driver eliom --remap` (after preprocessing the installed manual `.mld`), assembles every page into the Ocsigen site and writes the version redirect. Add `--local` to fetch the shared `/css//img/` assets and preview offline. > **Prerequisite (CI).** Eliom's cross-library links need the `odoc_driver` > `base_args` fix, which is not yet upstreamed. CI must pin `odoc` / `odoc-driver` > from the patched source until that lands; see the workflow comments. ## Deployment (CI) [`.github/workflows/doc.yml`](../.github/workflows/doc.yml) builds and publishes to the project's **`gh-pages`** branch (served at `ocsigen.org/eliom/`). The CI triggers **only on `master`**, so pushing any other branch never deploys: - **push to `master`** → rebuilds and deploys the **`dev`** docs only. Stable versions are **not** built by CI: they are generated by hand and committed to `gh-pages` (with the `latest` symlink repointed) at release time. Each CI run replaces only the `dev/` directory; the other version directories already on `gh-pages` are preserved. ## Releasing a stable version The CI builds only `dev/`. To publish a stable version, trigger the **Documentation** workflow's `release` job with the **version** input — either: - **CLI** (from a clone of the repo): `gh workflow run doc.yml -f version=12.1` - **GitHub UI**: repo → *Actions* → *Documentation* (left sidebar) → *Run workflow* (top-right) → set **version** (e.g. `12.1`) → *Run workflow*. The `release` job freezes the current `dev/` docs as `//`, repoints the `latest` symlink, writes the root redirect and refreshes `versions.json` — via `wodoc release --from dev --version `. No rebuild: the docs of a release are exactly the `dev` docs at that point. Equivalently, by hand on a `gh-pages` checkout: ``` wodoc release --site . --from dev --version git add -A && git commit -m "Release doc " && git push ``` eliom-13.0.0/doc/client.indexdoc000066400000000000000000000005661527170563500164640ustar00rootroot00000000000000{1 Client API} {!modules: Lib Client Client_value Request_info Config } {2 Content and form creation} {!modules: Content.Html Content.Html.Manip Content.Svg Content.Xml Tools } {2 Service creation} {!modules: Service Parameter Registration Eliom_uri } {2 Client/server communication} {!modules: Shared Cscache Bus Comet Eliom_react Request } {2 Index} {!indexlist} eliom-13.0.0/doc/clientserver/000077500000000000000000000000001527170563500161655ustar00rootroot00000000000000eliom-13.0.0/doc/clientserver/applications.mld000066400000000000000000000174411527170563500213600ustar00rootroot00000000000000@short_title Eliom applications {0 Programming client-server applications with Eliom} {1 General principles} {2 What is a client/server Eliom application} An Eliom application is a distributed application that runs partly on the server, partly on a browser. The program is written entirely in OCaml, with a syntax extension to distinguish between server and client code. During the compilation process, the program is decoupled into server and client parts. The server part is compiled as is standard for OCaml code, while the client part is compiled to Javascript to be run in the browser. For developing an Eliom application, we recommend that you use our {{!//clientserver/page-multitier}PPX syntax extension}. An interesting feature of Eliom applications is that the client-side process does not stop when you click on a link or send a form, and it is possible to keep the traditional Web interaction (with URLs, bookmarks, back button, etc). For example, if the page is playing music, the music won't stop when the user proceeds to other pages on the Web site. Client-side parts are using {{!/lwt/page-index}Lwt}, enabling concurrency in the browser very easily. As both parts are implemented in OCaml, it is very easy to use client-side OCaml data on server side, and vice-versa. Eliom handles the communication between client and server automatically in both directions. For example, it is possible to use a server-side variable in the client program. Eliom also implements an "HTTP-push" mechanism, allowing the server to send messages to a client. Client-side parts of the program can use most Eliom features, just as usual, for example to create HTML, links, and forms from services. On the server, it is possible to save data (some state) for each client process (that is, one tab in a browser), simply by using Eliom references with scope {!Eliom.Common.default_process_scope}. You can register services for one client process, or even set cookies for one tab. {2 How it works} The code of an Eliom application is written in OCaml, with {{!//clientserver/page-multitier}a syntax extension} to distinguish between server and client code. The files using this syntax usually have the extension [.eliom]. As the compiling process is quite complex, projects are built with dune, with rules generated by {{:https://github.com/ocsigen/ocsigen-dune-rules}ocsigen-dune-rules} (see {{!//workflow/page-distillery}Distillery}): they separate client and server parts, and call [ocamlc], [ocamlopt], [js_of_ocaml], etc. (Eliom also provides the commands [eliomc], [eliomopt] and [js_of_eliom], used by older build systems.) Services belonging to the application are registered using the module {!Eliom.Registration.App}. More precisely, this is a functor that needs to be applied for each application you create. These services just return HTML pages as usual (using {!Eliom.Content.Html}) The client-side program (compiled in JavaScript) is added automatically by Eliom, with all its data, and run automatically when the page is loaded. Module {!Eliom.Client} provides useful functions for client side programming with Eliom: e.g. {{:../eliom.client/Eliom/Client/index.html#val-change_page}[Eliom.Client.change_page]} permits switching to another page. Module {!Eliom.Comet} allows the server to send notifications to the client (even if the client is not explicitly doing a request). Use module {!Eliom.Eliom_react} to make client-server reactive programming (using the {{:http://erratique.ch/software/react} React} external library). {2 The App functor} For each Eliom application, you must create a service registration module by applying the [App] functor: {@ocaml[ module My_app = Eliom.Registration.App ( struct let application_name = "the name of your application" let global_data_path = None end) ]} the [application_name] parameter is the name of the JavaScript file containing the application. [global_data_path] specifies the path of an auxiliary service needed for mobile apps, and you can provide [None] for standard Web applications. Then you can do for example: {@ocaml[ let my_service = My_app.create ~path:(Eliom.Service.Path [""]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) (fun () () -> Lwt.return (html (head (title (txt "Hi!")) []) (body [p [txt "Hey."]]))) ]} Eliom will add automatically the required headers to send the client side program and all its data. {1 Application, life and death} When a user enters the page of a service registered by an application module (created with the [App] functor), the application is started. During the life of the application, a single OCaml program will run on the browser: Lwt threads will keep running, global variables will stay available, etc. until the application is closed. The application will keep running when the user clicks on links to pages inside the same application. This application will be closed when: - the user closes the browser tab containing the application, - the user goes to a page outside of the application, - the user changes the current url by another mean than the application interaction (reload the page with [F5], manual typing of URL, ...), - the application calls the {{:../eliom.client/Eliom/Client/index.html#val-exit_to}[Eliom.Client.exit_to]} function. It is possible to prevent the application from starting when visiting an application page by setting the [do_not_launch] to [true] at the service registration: {@ocaml[ let no_launch_service = My_app.create ~options:{ Eliom.Registration.default_appl_service_options with do_not_launch = true } ~path:(Eliom.Service.Path [""]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) (fun () () -> Lwt.return (html (head (title (txt "Hi!")) []) (body [p [txt "Hey."]]))) ]} That way, you can delay JavaScript loading until it is really needed. Visiting a service registered with [do_not_launch=true] will not stop a running application. By default, every link or form towards another service of the same application is reimplemented by Eliom so that it does not stop the application. Instead of asking the browser to load a new page, Eliom does an XML HTTP request (XHR). You can avoid this and insert regular links or forms by adding the optional parameter [~xhr:false]. This will force reloading the application when the link is clicked. {2 Navigating in and out of the application.} Two functions are available client-side for changing the current page without interaction from the user. The function {{:../eliom.client/Eliom/Client/index.html#val-change_page}[Eliom.Client.change_page]} goes to the service taken as parameter. If the service is in another application or not in an application, the current application will be stopped. The function {{:../eliom.client/Eliom/Client/index.html#val-window_open}[Eliom.Client.window_open]} opens an Eliom service in a new browser window (cf. JavaScript's [window.open]). {{:../eliom.client/Eliom/Client/index.html#val-exit_to}[Eliom.Client.exit_to]} changes the current page and always leaves the application. {2 Leaving application and going back} Usually, when going to an application page, a new client process is launched on the server, but there are situations where an old client process is used instead: Browsers tend to take the result from their cache when using the back button even if the page was marked (by HTTP headers) as non-cacheable. When the browser restores the page from its back-forward cache, the client-side program resumes where it was, with the same client process: its state of scope client process on the server is used again, unless it has expired in the meantime (see {{!//server/page-state.timeouts}Timeouts and session duration}). Otherwise, the page is loaded again and a new client process starts. eliom-13.0.0/doc/clientserver/cache.mld000066400000000000000000000012251527170563500177260ustar00rootroot00000000000000@short_title Caching data and off-line applications {0 Caching the data and off-line applications} {1 Caching the data} Module {!Eliom.Cscache} implements a cache of data that can be used both for keeping data on client side or keeping values in memory during a request. Have a look at the documentation of this module for more information. Also have a look at {!/ocsigenserver.baselib/Ocsigen_base.Cache} (from Ocsigen Server) for a server-side cache that keeps the most recently used values. {1 Off-line applications} In the future, Eliom.Cscache will make it possible to save persistent data, which is useful for implementing off-line applications. eliom-13.0.0/doc/clientserver/communication.mld000066400000000000000000000335771527170563500215470ustar00rootroot00000000000000@short_title Communication {0:communication Communication between the client and the server} Besides injections and client values, as described in the documentation of our {{!//clientserver/page-multitier}PPX syntax extension}, there are multiple ways for the client and the server to exchange values. {1:rpc Remote Procedure Calls} Eliom provides an easy way to call server functions from the client using a PPX syntax extension (provided by opam package [ocsigen-ppx-rpc]). Example: {%wodoc:@ class=shared%} {@ocaml[ let%rpc log (str : string) : unit Lwt.t = Lwt_io.write_line Lwt_io.stdout str ]} {%wodoc:@ class=client%} {@ocaml[ let%client () = Eliom.Client.onload (* NB The service underlying the server_function isn't available on the client before loading the page. *) (fun () -> Lwt.async (fun () -> log "Hello from the client to the server!")) ]} The type annotations are mandatory, for the syntax extension to be able to inject the correct serialisation functions. The serialisation functions for each type must be derivable using {!Deriving_Json}. To do that, just add [[@@deriving json]] after your type definitions. Example: {%wodoc:@ class=shared%} {@ocaml[ type%shared t = A | B [@@deriving json] ]} Exceptions raised in the server-side function cannot be handled directly on the client; it is impossible to marshal them in OCaml to send them to the client. Instead, if an exception is raised in the server function, the function application fails (in Lwt) on the client with the exception {{:../eliom.client/Eliom/Client_value/index.html#exception-Exception_on_server}[Eliom.Client_value.Exception_on_server]} whose argument describes the original exception (according to [Printexc.to_string]). {1:rpc_low_level Remote Procedure Calls: low level API} RPCs are just syntactic sugar for pathless services returning OCaml values. The PPX syntax extension translates the function definition into a {!Eliom.Client.server_function}. For example, the example above produces the following code: {@ocaml[ let%server log str = Lwt_io.write_line Lwt_io.stdout str let%client log = ~%(Eliom.Client.server_function [%json: string] log) ]} A function ['a -> 'b Lwt.t] can be wrapped on the server by {!Eliom.Client.server_function}. When the result is injected to the client, it appears as a plain function ['a -> 'b Lwt.t]. It is necessary to provide an instance of {!Deriving_Json} for the argument type, to safely send the argument from the client to the server. Syntax [[%json: t]] corresponds to the serialisation functions of type [t] Every call to [server_function] creates a new pathless POST service. If you want to use a server function in multiple places, it is thus advisable to only apply [server_function] once and bind it to an identifier. {1:notifs Notifications from server to clients} Module {!Eliom.Notif} makes it possible for a server to send values to clients with a very simple interface. See later in this chapter for lower level server push notifications. Create a module for each kind of notifications you want using the {!Eliom.Notif.Make_Simple} functor. For example, there would be a module for new message notifications in a chat. Each client process must subscribe to each resource for which it wants to receive the notifications (each chat currently opened, in our example), using the [listen] function of the module produced by {!Eliom.Notif.Make_Simple}. Then, the server can send a notification to all the clients listening on a resource, using its [notify] function. More details in the API documentation of module {!Eliom.Notif}. {1 Services returning OCaml values} Server functions are implemented using special services that take and return OCaml values. In this section we will see how to define services returning OCaml data. This is a lower level interface to do remote procedure calls, and you probably won't need this for basic use. These services are registered using {!Eliom.Registration.Ocaml} and can be called using {{:../eliom.client/Eliom/Client/index.html#val-call_ocaml_service}[Eliom.Client.call_ocaml_service]}. Such services cannot be visited by the browser as Web pages. You usually want POST pathless services for this use case. This corresponds to remote function calls, that are typically handled by pathless POST services. Example of use: {@ocaml[ open Eliom.Content let pi_service = Eliom.Registration.Ocaml.create ~path:Eliom.Service.No_path ~meth:(Eliom.Service.Post (Eliom.Parameter.unit, Eliom.Parameter.unit)) (fun () () -> Lwt.return 3.1415926535) let _ = My_appl.create ~path:(Eliom.Service.Path ["pi"]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) (fun () () -> ignore [%client (Lwt.async (fun () -> let%lwt pi = Eliom.Client.call_ocaml_service ~service:~%pi_service () () in Lwt.return ( Dom_html.window##alert (Js.string ("pi = "^ string_of_float pi)))) : unit) ]; Lwt.return Html.D.( html (head (title (txt "pi")) []) (body []))) ]} Since the client-side representation of values differs from the server-side representation, there are restrictions on what can be sent. The restrictions are the same as for the [~%variable] mechanism. (See {{!//clientserver/page-wrapping}chapter Wrapping}.) {1:client_sending_data Send OCaml values to services} The client can send OCaml values as parameters to services. To do that, declare the expected parameter type using [Eliom.Parameter.ocaml] (see {!Eliom.Parameter_sigs.S.ocaml}). This is used for example to implement server functions. Since the server cannot trust the client to send correctly-formed data, Eliom is not using the standard OCaml marshalling mechanism. (The server needs to be able to check that the value is of the expected type.) For this reason, you must declare the types of the data you want to be able to send to the server using the [[@@deriving json]] syntax extension of Js_of_ocaml (package [js_of_ocaml-ppx_deriving_json]): {@ocaml[ type%shared some_type = (int * string list) [@@deriving json] type%shared another_type = | A of some_type | B of another_type [@@deriving json] ]} This type can now be used as a parameter for a service: {@ocaml[ open Eliom.Content let s = My_appl.create ~path:(Eliom.Service.Path ["s1"]) ~meth: (Eliom.Service.Get (Eliom.Parameter.ocaml "param" [%json: another_type])) (fun v () -> Lwt.return Html.D.( html (head (title (txt "title")) []) (body [ match v with | A _ -> txt "A" | B _ -> txt "B" ]))) let _ = My_appl.create ~path:(Eliom.Service.Path ["s2"]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) (fun () () -> Lwt.return Html.D.( html (head (title (txt "title")) []) (body [p ~a:[a_onclick [%client (fun _ -> Lwt.async (fun () -> Eliom.Client.change_page ~service:~%s (A (1, ["s"])) ())) ]] [txt "Click to send Ocaml data"]]))) ]} It works for the datatypes you define, and the data types from OCaml's standard library. For types defined in third-party libraries, have a look at Js_of_ocaml's {!Deriving_Json}. {1 Server sending data (lower level interfaces for notifications)} Module {!Eliom.Notif} described above is implemented on top of a mechanism to allow the server to send data to a client. We call this mechanism {e Comet}. The same idea is also known as {e HTTP push}. The simple low-level version above which all other following mechanisms are implemented is provided in the {!Eliom.Comet.Channel} module. Comet defines channels which can transfer data. A channel is created using an Lwt stream. It is a kind of cooperative lazy list. The two main methods to create a stream are through the functions {!Lwt_stream.from} and {!Lwt_stream.create}. {@ocaml[ val from : (unit -> 'a option Lwt.t) -> 'a t val create : unit -> 'a t * ('a option -> unit) ]} Function {!Lwt_stream.from} makes possible to create a stream where a new value is added each time a function returns. Function {!Lwt_stream.create} returns a stream and a function to push new values to the stream. On client-side, the type {!Eliom.Comet.Channel.t} is just an Lwt stream {!Lwt_stream.t}. There are 3 kinds of channels, depending on how you want to send data. - Channels created with {!Eliom.Comet.Channel.create} have a buffer with a limited size. Messages are read from the stream as soon as they are available, i.e. for streams created with {!Lwt_stream.from}, that means that the function is called another time as soon as the previous one terminates. For streams created with {!Lwt_stream.create}, this is as soon as they are pushed. If the client misses too many messages (more than the size of the buffer) it will receive an exception {{:../eliom.client/Eliom/Comet/index.html#exception-Channel_full}[Eliom.Comet.Channel_full]} when reading data from the stream. - Channels created with {!Eliom.Comet.Channel.create_newest} have no buffering and can lose messages, but the client will always receive the last value: For instance, if many messages are sent in a short time, the client may receive only the last one. Those channels never raise {{:../eliom.client/Eliom/Comet/index.html#exception-Channel_full}[Eliom.Comet.Channel_full]}. - Channels created with {!Eliom.Comet.Channel.create_unlimited} consume data on the stream only when there is a request from the client. Channels can be closed on client side by cancelling a thread waiting for data on it. Like services, channels have a scope (only site or client process). The constraints vary with respect to the scope you choose: - Channels created with scope {!Eliom.Common.site_scope} or using {!Eliom.Comet.Channel.create_newest} are stateless channels: the memory consumption does not depend on the number of users requesting data on it. When the channels are not reachable from the server code, they are garbage-collected and closed. Named stateless channels can be accessed from {{!section:cors_channels}other servers}. - Channels created with scope {!Eliom.Common.default_process_scope} must be created inside a service handler. They are assigned to a particular client process. Different channels created with the same stream do not share memory. They are closed when requested or when the client process is closed. It is possible to know when a client stops requesting data on those channels using {!Eliom.Comet.Channel.wait_timeout}. Be careful about memory consumption when using client process channels. {2 Comet configuration} The server can push data to a client only when the client has an open HTTP connection waiting for a response. A Comet request waits at most 20 seconds by default ({!Eliom.Config.set_comet_timeout}, or the option [] of the configuration file). After that, the client can either do a new request or stay idle for some time: this is the activity behavior. This can be configured on client-side, using the functions from {{:../eliom.client/Eliom/Comet/Configuration/index.html}[Eliom.Comet.Configuration]} For instance, if you receive data which doesn't need frequent updates, you can set the time between different requests to a high value, and stop requesting data as soon as the browser loses the focus. {@ocaml[ let%client () = let open Eliom.Comet.Configuration in let slow_c = new_configuration () in set_active_until_timeout slow_c false; set_time_between_requests slow_c 60. ]} If you need more reactivity for a few seconds, do: {@ocaml[ let%client () = let open Eliom.Comet.Configuration in let fast_c = new_configuration () in set_always_active fast_c true; set_time_between_requests fast_c 0.; Lwt.async (fun () -> let%lwt () = Lwt_js.sleep 10. in drop_configuration fast_c; Lwt.return_unit) ]} The original setting will be reset after the drop. {1 Reactive values} A common usage of comet is for the server to update a value available on client side. A convenient way to implement this is to use reactive programming. Eliom provides a reactive interface for channels, using the {{:http://erratique.ch/software/react}React} library. To share a React event or signal with the client, use functions {!Eliom.Eliom_react.Down.of_react} or {!Eliom.Eliom_react.S.Down.of_react} On client-side, the value returned by those functions is directly a React event or signal. The opposite is also available using {!Eliom.Eliom_react.Up.create}. Since this is implemented using Comet, tuning Comet configuration will also affect the behaviour of shared react variables. {1 Client-Server shared bus} It is sometimes useful to have a bidirectional channel shared between multiple clients. This is the purpose of buses. Those are created using {!Eliom.Bus.create}. Since the server will also receive data on the bus, a JSON codec of the type ([[%json: t]], with [[@@deriving json]]) is needed to create a bus. Like comet channels, the behaviour of buses can be tuned using the module {{:../eliom.client/Eliom/Comet/Configuration/index.html}[Eliom.Comet.Configuration]}. There are additional configuration options available for buses to tune the client-side buffering. {1:cors_channels Another Server sending data (Comet on another server)} It is possible to access a named stateless channel created on another server. It has to be declared using {!Eliom.Comet.Channel.external_channel}. The declaration of the channel must match exactly the creation. The server generating the page and the server that created the channel must run exactly the same version of Eliom. By default a browser can't do requests to a different server, to allow that the server serving the channel must allow Cross-Origin Resource Sharing using the {{!/ocsigenserver/page-cors}CORS Ocsigenserver extension}. eliom-13.0.0/doc/clientserver/html.mld000066400000000000000000000446401527170563500176370ustar00rootroot00000000000000@short_title Generating HTML {0:server_generating_html Generating HTML pages} Ocsigen provides several ways to generate and type HTML pages. - The default technique to produce HTML pages using Eliom are the {!Eliom.Content.Html.F}, {!Eliom.Content.Html.D} and {!Eliom.Content.Html.R} modules. It is the only one supported for client-server Eliom programs. This module provides a typing based on OCaml's polymorphic variants, which ensures at compile time, that the pages you will generate will respect the recommendations of the W3C (or be very close). - It is also possible to use a syntax extension to write your pages with the usual HTML syntax. This solution is also typed with polymorphic variants and is compatible with the previous one. - You can also choose to generate untyped html as text. The types in OCaml closest to XML types are {e polymorphic variants}. Ocsigen uses them to provide a module with very good HTML typing. The full documentation is available {{!Tyxml.Html}in the TyXML documentation}. {1 Generating HTML for Eliom applications} {2 The TyXML library vs. the DOM API} On client side there are two kinds of HTML representations: one is based on the {{!/tyxml/page-index}TyXML library} and the other one is the browser DOM tree accessible through Js_of_ocaml modules {!Js_of_ocaml.Dom} and {!Js_of_ocaml.Dom_html}. The TyXML representation is a OCaml immutable typed tree. The DOM tree is mutable structure manipulated using the browser API which permit the modification of the displayed page. In the DOM representation, adding a node as a child to an other node removes it from its previous parent. Since those representations do not behave at all the same way, they are not used for the same thing. - It is far easier and safer to describe content using TyXML, but it is not possible to add a TyXML element to the page without explicit conversion to the DOM representation. - The TyXML representation has the same interface on client and server side. This allows share code between server and client. - Dom manipulation is heavy: to build some part of a tree, one needs to create each node separately then append them to their parents. For example, here is a [div] element built with TyXML and then converted to the DOM representation using the module {!Eliom.Content.Html}: {%wodoc:@ class=client%} {@ocaml[ open%client Eliom.Content.Html.D let%client n = div ~a:[a_id "some div id"] [ txt "some text"; br (); txt "some other text"; ] let%client b = Eliom.Content.Html.To_dom.of_div n ]} And here the same built using the DOM API: {%wodoc:@ class=client%} {@ocaml[ open%client Dom open%client Dom_html let%client d = let d = createDiv document in let t1 = document##createTextNode(Js.string "some text") in let t2 = document##createTextNode(Js.string "some other text") in let b = createBr document in appendChild d t1; appendChild d b; appendChild d t2; d##.id := (Js.string "some div id"); d ]} To ease the DOM manipulation on the client, the usual DOM manipulation function are also available on TyXML elements. See the next section for HTML element manipulation, by value and by reference. {2:unique HTML element manipulation, by value and by reference} There are four modules to create typed HTML: {!Eliom.Content.Html.F}, {!Eliom.Content.Html.D}, {!Eliom.Content.Html.C} and {!Eliom.Content.Html.R}. The last one is for reactive elements and is addressed in {{!section-reactive}another section}. It is possible to mix the four kinds of nodes in the same page. Elements built with [Html.F] are sent by value, while elements built with [Html.D] are sent to the client by reference. Eliom adds an identifier as attribute of [D] elements to make it possible to find them back in the page from client side. {%wodoc:div class="concept"%}{b In short: D or F?} - If your program is server-side only (Web site) or client-side only, use module [F]. - If you are writing a client-server Eliom program, module [D] will probably do what you expect most of the times. We recommend this as the default for beginners. But it will add identifiers attributes to each node. - If you want to avoid these identifiers when not needed, use module [D] only when the node is used in an injection ([~%n]), and module [F] otherwise. {%wodoc:end%} Sending elements by reference allows easy manipulation of elements included in the initial html document from event handlers, as the [input] element in the following example. {%wodoc:@ class=server%} {@ocaml[ let%server main_service = My_app.create ~path:(Eliom.Service.Path [""]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) (fun () () -> let open Eliom.Content.Html.D in let input = input ~a:[a_input_type `Text] () in let onclick_handler = [%client (fun _ -> let v = Js.to_string (Eliom.Content.Html.To_dom.of_input ~%input)##.value in Dom_html.window##alert(Js.string ("Input value :" ^ v))) ] in let button = button ~a:[a_onclick onclick_handler] [txt "Read value"] in Lwt.return (html (head (title (txt "Test")) []) (body [input; button]))) ]} In this example, if the input button would have been incorrectly sent by value, two different input fields would have been created: one displayed in the document and one referenced from the event handler. The latter will always contain an empty value. There are still two situations where sending elements by value is still required: - one wants to have multiple occurrences of the same elements in the document. Indeed, elements sent by reference follow the DOM semantics where an element has only one instance in the current document. For example, the following list will contain a single element:{%html:
%} {%html:
%} [let li = li [txt "Shared item"] in ul [li; li; li;]]. - one has a large page with a lot of elements. Handling elements by references add a small overhead while loading the page, around 50ms per 1000 elements on a not so fast computer. In any case, it is possible to mix elements sent by references and elements sent by value in the same document. By default, a reference on an element is only valid in the current HTTP request: hence, sending an element built with [Html.D] in two different pages will produce two distinct nodes. If you want to define an element reference that is preserved across the different pages of an application, you must explicitly name this element with the function {!val:Eliom.Content.Html.Id.create_named_elt}, that takes as parameters an element identifier and a non named element. Element identifiers are created with the function {!val:Eliom.Content.Html.Id.new_elt_id}. See also section {{!section:global}Global elements of an application}. The module {{:../eliom.client/Eliom/Content/Html/Manip/index.html}[Eliom.Content.Html.Manip]} allows using the classical DOM manipulation functions (e.g. appendChild, addEventlistener, ...) directly on HTML elements (or on element identifiers, with [Manip.Named]). {2:reactive Reactive DOM} [Eliom.Content.Html.R] allows one to insert time-varying values into the DOM tree. It relies on React's signal ['a React.signal]. More information about react can be found on the {{:http://erratique.ch/software/react} homepage}. The react nodes also use {{:https://github.com/ocsigen/reactiveData}ReactiveData}, which allows to manipulate lists of nodes in a reactive way. When dealing with dynamic content, one usually ends up with a lot of imperative DOM manipulations: replacing, appending, removing DOM elements, updating attributes, etc. [Html.R] hides most of those imperative DOM operations. Every time a signal changes, the corresponding DOM tree updates itself. {3 Usage on client side} To insert reactive DOM elements, just use module [Html.R] instead of [Html.D] or [Html.F] for these elements. [Html.R] makes also possible to define reactive attributes. Use function [Html.R.node : 'a elt React.signal -> 'a elt] to insert a reactive node in a page. {4 Example} {%wodoc:@ class=shared%} {@ocaml[ open%shared Eliom.Lib open%shared Eliom.Content open%shared Html open%shared F ]} {%wodoc:@ class=server%} {@ocaml[ module%server Reactivenodes_app = Eliom.Registration.App ( struct let application_name = "reactivenodes" let global_data_path = None end) ]} {%wodoc:@ class=client%} {@ocaml[ open%client Eliom.Content.Html let%client split s = let len = String.length s in let rec aux acc = function | 0 -> acc | n -> aux (s.[n - 1] :: acc) (pred n) in aux [] len let%client value_signal, set_value = React.S.create "initial" let%client value_len = React.S.map String.length value_signal let%client content_signal : Html_types.div_content_fun elt React.signal = React.S.map (fun value -> let l = split value in F.div ( List.map (fun c -> F.p [F.txt (Printf.sprintf "%c" c)]) l )) value_signal let%client make_color len = let d = (len * 10) mod 255 in Printf.sprintf "color: rgb(%d,%d,%d)" d d d let%client make_client_nodes () = [ D.p [R.txt value_signal]; D.p ~a:[ R.a_style (React.S.map make_color value_len)] [R.txt value_signal]; R.node content_signal ] ]} {%wodoc:@ class=server%} {@ocaml[ let%server make_input () = let inp = D.Raw.input ~a:[a_input_type `Text] () in let _ = [%client (Lwt_js_events.(async (fun () -> let inp = To_dom.of_input ~%inp in keyups inp (fun _ _ -> let s = Js.to_string (inp##.value) in set_value s; Lwt.return ()))) : unit) ] in inp let%server main_service = Eliom.Service.create ~path:(Eliom.Service.Path []) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) () let%server () = Reactivenodes_app.register ~service:main_service (fun () () -> let inp = make_input () in let cldiv = C.node [%client D.div (make_client_nodes ())] in Lwt.return (Eliom.Tools.F.html ~title:"reactivenodes" ~css:[["css"; "reactivenodes.css"]] (body [F.h1 [txt "Reactive DOM"]; inp; F.h2 [txt "Client side reactive nodes:"]; cldiv; ]) )) ]} {2:inject Dom & Client-values} [Eliom.Content.Html.C] allows one to insert client-side content into server-side HTML-trees. This makes possible, for example, to insert reactive nodes in a server-side generated page. {3 Example} {%wodoc:@ class=shared%} {@ocaml[ open%shared Eliom.Lib open%shared Eliom.Content open%shared Html open%shared F ]} {%wodoc:@ class=server%} {@ocaml[ module%server Testnodes_app = Eliom.Registration.App ( struct let application_name = "testnodes" let global_data_path = None end) let%server main_service = Eliom.Service.create ~path:(Eliom.Service.Path []) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) () ]} {%wodoc:@ class=client%} {@ocaml[ open%client Eliom.Content.Html let%client (value_signal : string React.signal), set_value = React.S.create "initial" ]} {%wodoc:@ class=server%} {@ocaml[ let%server client_reactive_attrib () = [%client R.a_style value_signal ] let%server client_reactive_title () = [%client F.h1 [txt "I'm a client node"] ] let%server () = Testnodes_app.register ~service:main_service (fun () () -> Lwt.return (Eliom.Tools.F.html ~title:"testnodes" ~css:[["css"; "testnodes.css"]] (body [ F.div ~a:[C.attr (client_reactive_attrib ())] [ C.node (client_reactive_title ()) ] ]))) ]} Module C is also available on client-side, to make it possible to use it in shared sections. {2:global Global elements of an application} Sometimes you may want to modify the content of an HTML element and to keep the element and its modified content when changing page. For example a [div] element which contains a chat box or a music player should be preserved while browsing across the different pages of your site. For this purpose, Eliom provides a notion of global element. Such elements are instantiated only once for an application and that unique instance is used in every page that references the element. To create a global element, use function {{!val:Eliom.Content.Html.Id.create_global_elt}Eliom.Content.Html.Id.create_global_elt}. {@ocaml[ val create_global_elt: 'a elt -> 'a elt ]} In the following example, the content of [global_list] will be preserved when you click on the "reload page" link. {%wodoc:@ class=shared%} {@ocaml[ open%shared Eliom.Content.Html.D ]} {%wodoc:@ class=server%} {@ocaml[ module%server My_app = Eliom.Registration.App ( struct let application_name = "myo" let global_data_path = None end) let%server global_list = Eliom.Content.Html.Id.create_global_elt (ul []) let%server cpt = ref 0 let%server main_service = Eliom.Service.create ~path:(Eliom.Service.Path [""]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) () let%server reload_link = a ~service:main_service [txt "reload page"] () let%server _ = My_app.register ~service:main_service (fun () () -> let page_number = incr cpt; string_of_int !cpt in let append_item = [%client fun _ -> let item_text = "item inserted in page #" ^ ~%page_number in let item = Eliom.Content.Html.To_dom.of_li (li [txt item_text]) in Dom.appendChild (Eliom.Content.Html.To_dom.of_ul ~%global_list) item ] in let append_link = Raw.a ~a:[a_onclick append_item] [txt "append item"] in Lwt.return (html (head (title (txt "Test")) []) (body [h1 [txt ("Page #" ^ page_number)]; p [append_link]; p [reload_link]; global_list]) ) ) ]} Another use of global element is for external javascript that should be included in every page but must be executed only once in an application. In the following code snippet, the alert "global script" is displayed only once, while the alert "non global script" is displayed every time you click on the "reload page" link. {%wodoc:@ class=server%} {@ocaml[ open%server Eliom.Content.Html.D let%server global_script = Eliom.Content.Html.Id.create_global_elt (script (cdata_script "alert(\"global script\")")) let%server simple_script = script (cdata_script "alert(\"non global script\")") let%server main_service = Eliom.Service.create ~path:(Eliom.Service.Path []) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) () let%server reload_link = a ~service:main_service [txt "reload page"] () let%server _ = My_app.register ~service:main_service (fun () () -> Lwt.return (html (head (title (txt "Global script example")) [global_script; simple_script]) (body [p [reload_link]]))) ]} {2:syntax HTML syntax extension} It is possible to use regular HTML syntax using Tyxml's PPX syntax extension. See {{!/tyxml/page-ppx}Tyxml's manual}. {2:text_html Text HTML} The last possibility is to use untyped HTML. Just build strings containing your pages. Here is an example: {%wodoc:@ class=server%} {@ocaml[ let%server hello = Eliom.Registration.Html_text.create ~path:(Eliom.Service.Path ["hello"]) ~meth:(Eliom.Service.Get Eliom.Parameter.unit) (fun () () -> Lwt.return "Hello") ]} Writing HTML as text makes applications much more difficult to maintain. We do not recommend this. {2:raw_html Raw HTML in a typed page} [Unsafe.data] inserts a string of HTML in a TyXML tree, as it is, for example an SVG image made by another library. Nothing checks or escapes this string: content from users must be sanitized first. {%wodoc:@ class=shared%} {@ocaml[ let%shared image svg = div [Unsafe.data svg] ]} The client parses the string as the content of its parent element, and the scripts it contains run. For well-formed markup allowed in that element, it gives the same nodes as the server. A string that gives several top-level nodes does not form one element: as a D node or in reactive content, raw HTML must give a single node, so wrap it in an element. {2:custom_data Custom data for HTML} Eliom provides a type-safe interface for creating new attributes of the form [data-*], using {!Eliom.Content.Html.Custom_data}. {3 Creation} Custom data may be created either from string-conversion functions by {!val:Eliom.Content.Html.Custom_data.create} {%wodoc:@ class=server%} {@ocaml[ open%shared Eliom.Content let%server my_int_data = Html.Custom_data.create ~name:"my_int" ~of_string:int_of_string ~to_string:string_of_int () ]} or by a Json-deriving type {!Eliom.Content.Html.Custom_data.create_json} {%wodoc:@ class=shared%} {@ocaml[ type%shared coord = { x : int; y : int; } [@@deriving json] let%shared coord_data = Html.Custom_data.create_json ~name:"coord" [%json: coord] ]} {3 Injecting} Custom data can be injected into HTML-trees of type {!Eliom.Content.Html.elt} by the function {!Eliom.Content.Html.Custom_data.attrib}: {@ocaml[ div ~a:[Html.Custom_data.attrib coord_data {x = 100; y = 200}] [] ]} {3 Reading/writing the DOM} On the client side, custom data can be read from and written to JavaScript DOM elements of type {!type:Js_of_ocaml.Dom_html.element}. Custom data can be read from a DOM-element with the function {{:../eliom.client/Eliom/Content/Html/Custom_data/index.html#val-get_dom}[Eliom.Content.Html.Custom_data.get_dom]}. If no respective custom data attribute can be found in the element - the [default] value from creating the custom data is returned, if any, or - an exception [Not_found] is raised, otherwise. The custom data of a DOM-element can be set with the function {{:../eliom.client/Eliom/Content/Html/Custom_data/index.html#val-set_dom}[Eliom.Content.Html.Custom_data.set_dom]}. {@ocaml[ [%client fun (div : Dom_html.element Js.t) -> let i = Html.Custom_data.get_dom div coord_data in Js_of_ocaml.Console.console##log (Js.string (Printf.sprintf "{x=%d; y=%d}" i.x i.y)); Html.Custom_data.set_dom div coord_data { x = i.x + 1; y = i.y - 1 } ] ]} {3 Default value} If a custom data is created with the optional argument [default], calls to {{:../eliom.client/Eliom/Content/Html/Custom_data/index.html#val-get_dom}[Eliom.Content.Html.Custom_data.get_dom]} return that instead of throwing an exception [Not_found]. {@ocaml[ let coord_data' = Html.Custom_data.create_json ~name:"coord" ~default:{x = 0; y = 0} [%json: coord] ]} eliom-13.0.0/doc/clientserver/index.mld000066400000000000000000000025111527170563500177710ustar00rootroot00000000000000@children_order applications multitier html communication services react cache wrapping @toc_status hidden {0 Client-server programming} An Eliom application runs partly on the server and partly in the browser or in a mobile app. It is written as one OCaml program, and a syntax extension says where each piece of code runs. - {{!//clientserver/page-applications}Eliom applications}: the general principles. - {{!//clientserver/page-multitier}Multi-tier programming}: the syntax extension, with shared sections, client fragments and injections. - {{!//clientserver/page-html}Generating HTML}: typed HTML built on the server or on the client, elements kept by reference, and reactive pages. - {{!//clientserver/page-communication}Communication}: remote procedure calls, notifications from the server, and the other ways to exchange values. - {{!//clientserver/page-services}Client-side services}: services whose handlers run on the client. - {{!//clientserver/page-react}Shared reactive programming}: reactive values defined on the server and used on the client. - {{!//clientserver/page-cache}Caching data and off-line applications}: a cache of data for the client, and applications that work off-line. - {{!//clientserver/page-wrapping}Custom wrapping}: how server values are sent to the client; useful when working on Eliom itself. eliom-13.0.0/doc/clientserver/multitier.mld000066400000000000000000000154031527170563500207040ustar00rootroot00000000000000@short_title Multi-tier programming {0 Eliom PPX syntax extension} The eliom syntax extension allows to write, in one file, both the client and server part of your application. The extension is automatically enabled by the default build system on [.eliom] and [.eliomi] files. The extensions presented here are also available with the [eliom.] prefix. {1 Sections} The location of code execution is specified by section annotations. We can specify that a declaration is performed on the server, or on the client: {%wodoc:@ class=server%} {@ocaml[ let%server s = ... ]} {%wodoc:@ class=client%} {@ocaml[ let%client c = ... ]} Or, alternatively: {%wodoc:@ class=server%} {@ocaml[ [%%server let s = ... ] ]} {%wodoc:@ class=client%} {@ocaml[ [%%client let c = ... ] ]} Finally, it's also possible to start a section for the rest of the file: {@ocaml[ [%%server.start] let s = ... ]} In [.eliomi] files, the three forms are available, with signatures: [val%server x : t], [[%%server: val x : t]], and [[%%server.start]]. Sections are only available at top level and cannot be nested. Similarly, you can write for example [type%server], [module%server], [open%server], etc ... {2 Shared sections} Shared sections are also available for code that should be on the client and on the server. {%wodoc:@ class=shared%} {@ocaml[ let%shared sh = ... ]} This is equivalent to duplicating the code in a client and a server section. Each copy refers to the declarations of its own side, which may differ: {@ocaml[ let%server output s = print_endline s let%client output s = Dom_html.window##alert (Js.string s) let%shared () = output "Hello" ]} Here, [output] is the server function in the server copy, and the client function in the client copy. {1 Client fragments} A client-side expression can be included inside a server section, and the server can thereafter refer to it: an expression placed inside [[%client ... ]] will be computed on the client when it receives the page; but the eventual client-side value of the expression can be manipulated as a black box on the server. {%wodoc:@ class=server%} {@ocaml[ let%server x = [%client 1 + 3 ] ]} For example, here, the expression [1 + 3] will be evaluated on the client, but it’s possible to refer server-side to the future value of this expression (for example, put it in a list). The value of a client fragment cannot be accessed on the server. In this case, [x] has type [int Eliom.Client_value.t]. Eliom can't always infer the type of fragments. In this case, you may annotate the type: [[%client ( ... : ) ]]. Client fragments cannot be nested. {2 Shared fragments} It is also possible to use shared fragments. {%wodoc:@ class=server%} {@ocaml[ let%server x = [%shared ...] ]} It will produce values of type {!Eliom.Shared.Value.t}. Shared fragments can contain client fragments. {1 Injections and escaped values} Values that have been computed on the server can be used on the client by prefixing them with a percent symbol [~%]. We call this an {e injection}. {@ocaml[ let%server s = 1 + 2 let%client c = ~%s + 1 ]} Here, the expression [1 + 2] is evaluated and bound to variable [s] on the server. The resulting value [3] is transferred to the client together with the Web page, then the expression [~%s + 1] is computed client-side. An injection makes it possible to access client-side a client fragment which has been specified on the server: {@ocaml[ let%server x = [%client 1 + 3 ] let%client c = 3 + ~%x ]} The value inside the client fragment is extracted by [~%x], whose value is [4] here. Any server-side expression can be injected, with parentheses: [~%(f x)]. The injected expression is evaluated on the server once, when the server loads the module, just before the declaration that contains the injection. It can thus only refer to server-side values defined before this declaration, not to client-side variables. Each client process receives a copy of the value with its first page: later changes on the server are not seen by the client. To follow a server-side value, inject a reactive signal (see {!val:Eliom.Eliom_react.S.Down.of_react}). {@ocaml[ let%client server_start = ~%(Unix.gettimeofday ()) ]} Here, [server_start] is the time when the server loaded the module, not the time of the request. In a shared section, the server copy uses the value of the injected expression directly, computed in the same way. Inside a client fragment, [~%] also accepts the local variables of the server code around the fragment: their value, when the fragment is created, is sent with the fragment (see [~%n] in the {{!section-clientvalues}example below}). {1 Restrictions} It is not possible to use injections on values containing a closure. This includes lazy values, objects, or anything containing functions. You can use {!Eliom.Client.server_function} ([let%rpc]) or client or shared fragments to circumvent this limitation. To extend and customize the serialization from server to client, see chapter {{!//clientserver/page-wrapping}Wrapping values}. {1:evaluation Evaluation} {2 Top-level code} On the server, top-level declarations are evaluated when the server loads the module, before any request: no information on a request is available at that time. On the client, top-level declarations are evaluated when the client process starts, before the page is in the DOM. To act on the page, use {{:../eliom.client/Eliom/Client/index.html#val-onload}[Eliom.Client.onload]}. {2:clientvalues Global and request client fragments} Regardless of the construction used and their combination, there is only one communication from server to client, when the Web page is sent. Client fragments are not executed when the server meets them: the server registers them for later execution, and the client executes them once it has received the page. A client fragment created when the server loads the module is {e global}. Global fragments are executed when the client process starts, together with the client sections, in the order of the program. This example prints the numbers 1 to 5 in the browser console, in this order: {@ocaml[ let%client () = print_endline "1" let%server f n = ignore [%client (print_endline (string_of_int ~%n) : unit)] let%server () = ignore [%client (print_endline "2" : unit)]; f 3; f 4 let%client () = print_endline "5" ]} A client fragment created while the server processes a request is a {e request} fragment. The client executes request fragments when it receives the response, in the order of their creation on the server. When the response is a page of an Eliom application (see {!Eliom.Registration.App}), they are executed once the new content is in the page, so they can use its elements. Creating a client fragment in any other context (for example in a thread that runs after the server has started, outside of any request) raises an exception. eliom-13.0.0/doc/clientserver/react.mld000066400000000000000000000131641527170563500177660ustar00rootroot00000000000000@short_title Shared reactive programming {0:sharedreact Shared reactive programming} In reactive programming, the programmer declaratively defines relationships between different pieces of data, and between the data and what is displayed in the interface. This allows rapid development of robust user interfaces. {{!//clientserver/page-html.reactive}Another manual section} describes Eliom's client-side reactive infrastructure. Client-side reactive programming in itself does not adequately cover all the requirements of the modern Web. Namely, with client-centric programming, the initialization of the interface happens on the client, sometimes with a noticeable lag. Also, the HTML sent by the server contains little of the actual content, thus being unsuitable for search-engine indexing. To overcome this limitation, Eliom 5.0 and higher enable what we call {e shared} reactive programming. This means that we operate on signals that have both a server-side and a client-side meaning. The server-side signals produce a first version of the interface that is more than a skeleton, while the client-side signals are responsible for the dynamic updates. {1 Shared signals} Our client-side reactive infrastructure heavily relies on the {{:http://erratique.ch/software/react} React} library. The module {!Eliom.Shared.React} builds on [React] to provide {e shared} signals (type [Eliom.Shared.React.S.t]). We explain the ideas behind {!Eliom.Shared.React} aided by the following example. {@ocaml[ let%server (s : int Eliom.Shared.React.S.t), (f : (?step:React.step -> int -> unit) Eliom.Shared.Value.t) = Eliom.Shared.React.S.create 0 let%client incr_s () = let v = Eliom.Shared.React.S.value ~%s in ~%f (v + 1) let%shared msg_of_int i = Printf.sprintf "value is %d" i let s_as_string () : string Eliom.Shared.React.S.t = Eliom.Shared.React.S.map [%shared msg_of_int] s ]} {!module:Eliom.Shared.React.S} implements an interface very similar to plain [React.S]. In the example, we create a signal [s] via [create], which also gives us the function [f] for updating it. [f] can {e only} be called on the client side; calling it on the server raises an exception. The client-side function [incr_s] gets the current value of [s] and uses [f] to increase the value by 1. Note that we use injections [~%] to pass [s] and [f] to the client. Similarly to plain [React], we can use [Eliom.Shared.React.S.map] to derive new signals by applying functions on previous signals. The difference is that we need to use a function (in the example, [msg_of_int]) implemented on both sides ([let%shared]). We use [[%shared msg_of_int]] to denote the combination of the two implementations, rather than the server-side implementation. (The example would also work with an anonymous function inside [[%shared ...]]: [[%shared (fun i -> Printf.sprintf "value is %d" i)]]). Since the signals do not get updated on the server, all server-side computation is one-off. For example, the server-side [msg_of_int] will be called only once. On the client, updates happen just like for plain [React]. {1 HTML and SVG content} The server-side module {!Eliom.Content.Html.R} enables constructing HTML elements that get updated automatically based on {!Eliom.Shared.React} signals. Continuing our example, we can use the signal [s_as_string ()] as follows: {@ocaml[ let%server node () = Eliom.Content.Html.R.txt (s_as_string ()) ]} [node ()] can be used similarly to any node produced by {!Eliom.Content.Html.D} or {{!Eliom.Content.Html.F}F}: {@ocaml[ (* ... *) let () = Shared_reactive_app.register ~service:main_service @@ fun () () -> Lwt.return @@ Eliom.Tools.F.html ~title:"shared_reactive" ~css:[["css";"shared_reactive.css"]] Eliom.Content.Html.(F.body [ F.h2 [F.txt "Welcome from Eliom's distillery!"]; node (); F.p ~a:[F.a_onclick [%client fun _ -> incr_s ()]] [F.txt "incr s"]; ]) ]} {!Eliom.Content.Svg.R} operates in a similar fashion, allowing for shared reactive graphics. {1 ReactiveData} Just like {!Eliom.Shared.React} is the shared counterpart of [React], {!Eliom.Shared.ReactiveData} is the shared counterpart of {{:https://github.com/ocsigen/reactiveData}ReactiveData}. We provide an example. {@ocaml[ let (l : int Eliom.Shared.ReactiveData.RList.t), (h : int Eliom.Shared.ReactiveData.RList.handle) = Eliom.Shared.ReactiveData.RList.create [] let%client cons_to_l () = Eliom.Shared.ReactiveData.RList.cons 1 ~%h ]} We use [create] to produce a shared reactive list [l] of integers. We also obtain a {e handle} that allows us to manipulate the list on the client, e.g., by adding elements as per the function [cons_to_l]. [Eliom.Shared.ReactiveData.RList.map] applies a given shared function to every element of a shared reactive list (including new elements as they are produced), producing a new shared reactive list: {@ocaml[ let l_nodes () = Eliom.Shared.ReactiveData.RList.map [%shared fun i -> Eliom.Content.Html.D.txt (Printf.sprintf "[%d]" i) ] l ]} Shared reactive lists can (and need to) be used wherever {!Eliom.Content.Html.R} expects lists, e.g., we can build a [
] as follows: {@ocaml[ let l_div () = Eliom.Content.Html.R.div (l_nodes ()) ]} Adding a new element via [cons_to_l] does not rebuild the whole [l_div ()], but only adds a new child. Similarly, in the case where existing nodes are updated, only the modified ones are re-rendered after every update operation. {1 Links} - {{:http://erratique.ch/software/react} React} - {{:https://github.com/ocsigen/reactiveData}ReactiveData} - {{!//clientserver/page-multitier}Our PPX syntax extension}, which is crucial for enabling the discussed paradigm eliom-13.0.0/doc/clientserver/services.mld000066400000000000000000000065751527170563500205230ustar00rootroot00000000000000@short_title Client-side services {0 Client-side services} Starting with Eliom 6.0, services can have client-side handlers. Registering client-side handlers for services allows us to perform most of the operations (e.g., building the user interface) locally, and only call the server for operations that are by necessity non-local (e.g., retrieving database data). Client-side service implementation is required for building mobile applications with Eliom, but can also be used to change page faster within a Web application. In this manual chapter, we focus on the client-side service mechanics and do not go into the details of setting up a complete mobile application. The complete setup needed is discussed in the {{!//workflow/page-mobile}mobile applications chapter} of this manual. {1 Service creation and registering} As described in the chapter {{!//server/services/page-types}on server-side services}, services are first created via {!Eliom.Service.create} and similar functions, and subsequently registered. The first step (creation) can only happen on the server; allowing the opposite would permit "creating" on the client services that are not actually provided by the server. To allow client-side service manipulation, services can be injected, as demonstrated by the following example: {@ocaml[ let%server s = Eliom.Service.create ~meth:(Eliom.Service.Get Eliom.Parameter.unit) ~path:(Eliom.Service.Path ["content"]) () let%client s = ~%s ]} The above style makes the service available under the same identifier (here [s]) on both sides. Subsequently, the service can be registered on both sides with the same {!Eliom.Registration} APIs. For example: {@ocaml[ let%shared () = Eliom.Registration.Html.register ~service:s (fun () () -> Lwt.return (Eliom.Tools.F.html ~title:"hybrid" Eliom.Content.Html.F.(body [h1 [txt "Salut !"]]))) ]} The types of the handlers are compatible between the two sides. For instance, {!Eliom.Registration.Html} expects a function that produces a [Html_types.html Eliom.Content.Html.D.elt Lwt.t], for {!Eliom.Registration.Action} we must return [unit Lwt.t], and so on. The behavior of all services is compatible to the extent possible, e.g., actions perform a reload after performing their side effect. For application services, the {!Eliom.Registration.App} functor needs to be called just like on the server. The signatures are compatible between the two sides, and therefore the functor invocation can happen in a shared section. A service registered as above can be called via links (e.g., [Eliom.Content.Html.D.a]) and forms just like a standard server-only service. Eliom detects the existence of a client-side implementation and calls that instead of performing a request to the server. If no client-side implementation exists, a standard server request is performed, which may cause problems in the context of mobile applications. {1 Service routing} Service routing is the operation of choosing a service based on a URL and a collection of POST parameters. This is clearly a key operation on the server, allowing Eliom to respond on different paths. Routing has also become available on the client via the function {{:../eliom.client/Eliom/Client/index.html#val-change_page_uri}[Eliom.Client.change_page_uri]}. This function can be used for example in order to open a link inside a mobile application without launching the Web browser. eliom-13.0.0/doc/clientserver/wrapping.mld000066400000000000000000000103241527170563500205120ustar00rootroot00000000000000@short_title Custom wrapping {0:wrapping Wrapping} Reading this chapter is not mandatory for writing Eliom applications. However, it is worth reading if you are planning to hack on the Eliom codebase. {1 Basics} The server side of Eliom can communicate to the client other kinds of data than the raw XML contents of the pages. The wrapper mechanism is used to allow the browser side to access to the contents of variables declared on server side. For instance when we write {@ocaml[ ignore [%client (Dom_html.window##alert(Js.string ~%text) : unit)] ]} the contents of the [text] variable is sent along the page for the client code to access it. Server side, when {@ocaml[ [%client (Dom_html.window##alert(Js.string ~%text) : unit)] ]} is executed, the variable [text] is registered into a table and an id is associated to it. This table will contain all the data referenced by variables annotated with [~%] in a page, and will be sent marshalled to the client. On client side the id will be used to retrieve [text]. Since all data are sent in one table, if a variable is referenced multiples times, it will be sent only once, and sharing will be preserved: {@ocaml[let a = ref 0 in let b = (1,a) in ignore [%client ((~%a := 42; Dom_html.window##alert(!(snd ~%b) |> string_of_int |> Js.string)) : unit) ] ]} This code will display 42. After being sent, the client and server side values are distinct: the server side version of [a] won't be modified by the client side assignment and conversely the client side value won't change if [a] is changed later on server side. {1 Special types} {2 Custom wrappers} Usually, client and server side values are represented the same way, and it is sufficient to only copy their content ( marshalled ) to the client. But certain types can't be transmitted this easily: for instance, services. Those values must be transformed before marshalling: We need for this to use custom wrappers. This wrapping mechanism is defined in {!Eliom.Wrap}. Before sending, values go through {!Eliom.Wrap.wrap}, which transforms marked values. A marked value is a value which has as its last field a value of type {!Eliom.Wrap.wrapper}. For instance {@ocaml[type marked_tuple = int * ... * marked_tuple Eliom.Wrap.wrapper type marked_record = { f1 : int; ... fn : marked_record Eliom.Wrap.wrapper } ]} but not {@ocaml[type not_marked_tuple = int * ... * marked_tuple Eliom.Wrap.wrapper * float type not_marked_tuple = int * ... * (int * marked_tuple Eliom.Wrap.wrapper) type not_marked_tuple = int * ... * marked_tuple Eliom.Wrap.wrapper list type not_marked_record = { f1 : int; ... fn : marked_record Eliom.Wrap.wrapper; fk : float; }]} A wrapper is created by the {!Eliom.Wrap.create_wrapper} function. It takes a function as parameter which will be called to transform the value during the wrapping. There is also a special wrapper {!Eliom.Wrap.empty_wrapper} which does nothing. It is useful to stop calling the wrapper on a value: If there is still a wrapper in a value after its transformation, it will be called another time, potentially leading to an infinite loop. For instance {@ocaml[type v = Fun of unit -> int | Value of int type wrapped_type = v * wrapped_type Eliom.Wrap.wrapper let wrapper = let wrap = function | Value i,wrapper -> Value i, Eliom.Wrap.empty_wrapper | Fun f,wrapper -> Value (f ()), Eliom.Wrap.empty_wrapper in Eliom.Wrap.create_wrapper wrap let v = ( Fun (fun () -> 1), wrapper )]} When [v] is sent to the client, the value received is [(Value 1, empty_wrapper)]. Notice that {!Eliom.Wrap.create_wrapper} does not enforce the output type of the wrapping function to be the same as the input type: Eliom.Wrap is to be used with much caution! Do not use it if you don't understand how it works, it may lead to unpredictable segmentation faults and corrupted memory. {1 Eliom types with predefined custom wrappers} The Eliom types that are marked are: - {!Eliom.Service.t} transformed to {!Eliom.Service.t} (but the client side representation) - {!Eliom.Comet.Channel.t} transformed to {!Lwt_stream.t} - {!Eliom.Eliom_react.Up.t} transformed to ['a -> unit Lwt.t] - {!Eliom.Eliom_react.Down.t} transformed to ['a React.E.t] - {!Eliom.Bus.t} transformed to {!Eliom.Bus.t} eliom-13.0.0/doc/dune000066400000000000000000000011461527170563500143400ustar00rootroot00000000000000; Eliom manual pages (odoc .mld), installed with the package under ; odoc-pages/, where odoc_driver (ocaml.org, wodoc) builds them with the API. ; The manual is a tree: each subdirectory is a group of the navigation (its ; index.mld gives the group title and the order of its pages), installed ; with the same path. (documentation (package eliom) (files (glob_files_rec (*.mld with_prefix .)))) ; The per-package odoc configuration must sit at the root of the installed ; doc directory, next to odoc-pages/, for odoc_driver to find it. (install (section doc) (package eliom) (files odoc-config.sexp)) eliom-13.0.0/doc/index.mld000066400000000000000000000105101527170563500152620ustar00rootroot00000000000000@children_order intro server/ clientserver/ workflow/ {0 Eliom} {e The full-stack OCaml Web and mobile framework} Eliom is a framework for building client/server Web and mobile applications in OCaml. It can be used both as a traditional server-side Web framework or to implement complex client-server applications. Eliom transforms OCaml into a multi-tier language, making it possible to implement both the server and client parts of a Web and mobile app as a single program. This simplifies a lot the communication between server and client. Applications can run on any Web browser or mobile device (iOS, Android), removing the need to develop one version for each platform. Eliom has support for reactive pages (generated on server or client), an advanced session mechanism, server to client communication, continuation based Web programming, etc. {1 Installation Instructions} {v opam install eliom v} {1 A quick tour} Here is a quick overview of what programming with Eliom looks like. Defining a service on path [/foo], taking any GET parameters: {%wodoc:@ class=server%} {@ocaml[ let myservice = Eliom.Service.create ~path:(Eliom.Service.Path ["foo"]) ~meth:(Eliom.Service.Get (Eliom.Parameter.any)) () let () = Eliom.Registration.Html.register ~service:myservice (fun get_params () -> Lwt.return Eliom.Content.Html.F.(html (head (title (txt "")) []) (body [h1 [txt "Hello"]]))) ]} Inserting a link towards that service, with parameters: {%wodoc:@ class=server%} {@ocaml[ Eliom.Content.Html.D.a ~service:myservice [txt "Home"] [("param1", "v1"); ("param2", "v2")] ]} Event handlers are written in OCaml: {%wodoc:@ class=server%} {@ocaml[ div ~a:[a_onclick [%client fun ev -> ... ]] [ ... ] ]} The client-side and server programs are written as a single program: {%wodoc:@ class=server%} {@ocaml[ let%server a = ... (* code for the server part of the application *) ]} {%wodoc:@ class=client%} {@ocaml[ let%client b = ... (* code for the client part of the application *) ]} {%wodoc:@ class=shared%} {@ocaml[ let%shared a = ... (* code that will be included in both parts *) ]} Using a server-side value in client-side code: {%wodoc:@ class=server%} {@ocaml[ let%server a = ... ]} {%wodoc:@ class=client%} {@ocaml[ let%client f () = print_endline ~%a (* print in browser console *) ]} Calling a server function from the client program (with {{:https://github.com/ocsigen/ocsigen-ppx-rpc}ocsigen-ppx-rpc}): {%wodoc:@ class=shared%} {@ocaml[ let%rpc f (x : int) : unit Lwt.t = ... (* server-side code *) ]} {%wodoc:@ class=client%} {@ocaml[ let%client g () = let%lwt r = f 4 in ... ]} Saving session data on the server using Eliom references: {%wodoc:@ class=server%} {@ocaml[ let%server r = Eliom.Reference.eref ~scope:Eliom.Common.default_session_scope 0 let%server f () = let%lwt v = Eliom.Reference.get r in let%lwt () = Eliom.Reference.set r (v + 1) in ... ]} Where scope can be: - [Eliom.Common.default_session_scope] (different value for each browser), - [Eliom.Common.default_process_scope] (different value for each tab), - [Eliom.Common.default_group_scope] (different value for each user), - [Eliom.Common.site_scope] (value for the whole site), - [Eliom.Common.global_scope] (global value for the whole server). Eliom references are persistent if you add [~persistent:(name, json_codec)] to function [Eliom.Reference.eref]. Their values are then stored with Ocsipersist, whose database location {{!//server/page-state.ocsipersist_config}must be configured}. {1 Learning Eliom} To learn Eliom, read one of the main documentation pages first: {{:https://ocsigen.org/tuto/latest/basics.html}application development} (client-server programming) or {{:https://ocsigen.org/tuto/latest/basics-server.html}website development} (server-side programming). Write your first Web and mobile application with Eliom using {{!/ocsigen-start/page-index}Ocsigen Start}. If you want to use Eliom as a traditional server-side Web framework, have a look at these tutorials: - {{:https://ocsigen.org/tuto/latest/basics-server.html}A basic Web site in OCaml} - {{:https://ocsigen.org/tuto/latest/how-to-register-session-data.html}Session data: Eliom references} - {{:https://ocsigen.org/tuto/latest/interaction.html}Service based Web programming} Read the full {{!page-"intro"}reference manual} for technical details. eliom-13.0.0/doc/intro.mld000066400000000000000000000161371527170563500153210ustar00rootroot00000000000000{0 Introduction} {e This document is the Eliom manual, where you will find a detailed explanation of all Eliom concepts. If you want to learn how to program with Ocsigen, please read the {{:https://ocsigen.org/tuto/}Ocsigen tutorial} first, and especially {{:https://ocsigen.org/tuto/latest/basics.html}this overview of all concepts} or the {{:https://ocsigen.org/tuto/latest/basics-server.html}server-side programming guide}.} Eliom is a framework for developing Web and mobile applications. It can be used to implement either basic server-side Web sites, or advanced client-server applications accessible through a Web browser. From Eliom 6.0, it is also possible to implement, with a single code base, {b multi-platform applications} that will run on a {b Web browser} or a {b mobile} device (iOS, Android...). The goal of Eliom (and other projects of the Ocsigen framework) is to propose a new programming style that matches the needs of modern Web applications better than the usual languages (most of which were designed years ago, for a much more static Web). It simplifies the development of complex applications by: - providing high level expressive concepts that address the needs of Web developers. This allows programming complex behaviour in very few lines of code. - making it possible to write a client-server application as a single program, using a multi-tier extension of OCaml. - helping the programmer to write safe and bug-free applications. To improve security, it takes charge of many security issues itself. To reduce the number of bugs, it uses the very powerful type system of the OCaml language to check many properties of the application at compile time: well-formedness of HTML pages, types of page parameters, absence of broken links, etc. Eliom does not restrict the possibilities offered by Web technology. For example, the programmer can choose the exact URL and parameter names she wants. Eliom also produces clean HTML code that can be parsed by search engines, even for client/server applications. Eliom is not an entirely new language, but an extension of OCaml. An Eliom application can use any existing OCaml library. The server-side code of an Eliom Web site is compiled into one or more {e Eliom modules}: OCaml libraries (or single modules) that either your own executable links statically with Ocsigen Server, or the [ocsigenserver] command loads dynamically ([cmo], [cma] or [cmxs] files), as specified in its configuration file. {1 Client/server applications} Eliom applications are applications distributed between a server and a browser. An instance of the application is running in a browser tab, and can communicate with the server. The entire application is written in OCaml, as a single program, with special syntax to distinguish between server-side and client-side code. Client-side code is compiled to JavaScript, using the Js_of_ocaml compiler, to be executed by the browser. It can also be compiled to WebAssembly using Wasm_of_ocaml, with automatic browser detection and fallback. It is possible to refer on the client side to values defined in server-side code. Communication between the server and the client is handled by Eliom automatically. The use of the same language on both sides makes it very easy to exchange data. It is possible to have a client side Eliom program and maintain the traditional Web interaction (with URLs, links, forms, bookmarks, and the back button). When you click on a link, the client-side program {e does not stop!} Thus: - You can keep a state on client side for the whole duration of the visit. - You can set bookmarks corresponding to some states of the client-side program. - Part of the page can persist after loading a new page. - If you are listening to music or watching a video, playback does not stop when you change page! {{!//clientserver/page-applications}More information...} {1 Services} Pages are generated by {e services}, which are a kind of functions that are called when the user clicks on a link, or sends data through a form in a Web page. Services can be associated to URLs. Eliom's {e service identification mechanism} (that is: the way Eliom chooses the service to be executed) is actually much more sophisticated. It is using many different criteria, like the URL, but also special parameters, the HTTP method used (GET or POST), parameter names, the session, etc. Services usually return HTML pages, but you can also choose to return files, redirections, actions (that is: just perform a side effect on the server and redraw the current page), applications, etc. Eliom services enable several ways of generating HTML. You can send HTML as raw text, as in most Web programming frameworks. However, it is preferable to check at compile time that every page generated respects the recommendations of the W3C. For this we are using the TyXML library. When defining a service, you must specify the names and types of the parameters it expects (through the URL or through the body of the HTTP request). Eliom automatically checks parameters and translates them to the right OCaml type (even for complex types like lists and sets). The OCaml compiler checks that the parameters you put in links have the right type (w.r.t. the service). It also checks that your forms correspond to the service to which they are associated. For example, if your form contains a checkbox, the service must expect a boolean value. Services can be created dynamically. For example, you can create new services that depend on previous interaction with the user (form data for example). This is equivalent to what is usually called {e continuation-based Web programming}. This enables for example implementing multiple-step forms very easily (like booking a plane ticket). {{!//server/services/page-types}More information...} {1 Sessions and server-side state} Eliom has a very advanced session mechanism. Sessions are a common pattern in Web programming, allowing some data (a state) to be stored on the server for each browser. This is used for example to recognize connected users, or to store a shopping basket. This is usually implemented by recording a session identifier in a browser cookie. With Eliom, session data is stored in {e Eliom references}, which are a kind of reference whose value depends on the session (the session identifier sent in the cookie). But you can choose other {e scopes} than "session" for Eliom references: - It is also possible to define references with scope {e "client process"}, which corresponds to a tab of your browser (if you are using client-side features). For example, if you are implementing a game, you can have several instances of the game in separate tabs. The score is stored on the server in an Eliom reference of scope "client process". - Eliom also provides the scope {e "session group"}. This allows for example grouping together all sessions belonging to the same user. For example, you can use this to share a shopping basket between several devices (e.g., the user's laptop and smartphone). - There is also a scope {e "request"} that can be used to store data during the generation of a page. {{!//server/page-state}More information...} eliom-13.0.0/doc/odoc-config.sexp000066400000000000000000000006151527170563500165520ustar00rootroot00000000000000; Per-package odoc configuration (read by odoc_driver, both on ocaml.org and ; by wodoc). Declares the dependencies whose modules and pages the manual ; references with the {!/package-or-library/...} path syntax. (libraries ocsigenserver ocsigenserver.baselib lwt.unix ocsipersist ocsigen-start.server ocsigen-toolkit.client) (packages ocsigenserver ocsigen-start ocsigen-toolkit tyxml lwt) eliom-13.0.0/doc/redirects/000077500000000000000000000000001527170563500154445ustar00rootroot00000000000000eliom-13.0.0/doc/redirects/clientserver-applications.html000066400000000000000000000007311527170563500235240ustar00rootroot00000000000000 Eliom applications

This page has moved to Eliom applications.

eliom-13.0.0/doc/redirects/clientserver-cache.html000066400000000000000000000007451527170563500221060ustar00rootroot00000000000000 Caching data and off-line applications

This page has moved to Caching data and off-line applications.

eliom-13.0.0/doc/redirects/clientserver-communication.html000066400000000000000000000007231527170563500237040ustar00rootroot00000000000000 Communication

This page has moved to Communication.

eliom-13.0.0/doc/redirects/clientserver-html.html000066400000000000000000000006631527170563500220060ustar00rootroot00000000000000 Generating HTML

This page has moved to Generating HTML.

eliom-13.0.0/doc/redirects/clientserver-react.html000066400000000000000000000007171527170563500221400ustar00rootroot00000000000000 Shared reactive programming

This page has moved to Shared reactive programming.

eliom-13.0.0/doc/redirects/clientserver-services.html000066400000000000000000000007151527170563500226630ustar00rootroot00000000000000 Client-side services

This page has moved to Client-side services.

eliom-13.0.0/doc/redirects/clientserver-wrapping.html000066400000000000000000000007031527170563500226640ustar00rootroot00000000000000 Custom wrapping

This page has moved to Custom wrapping.

eliom-13.0.0/doc/redirects/config.html000066400000000000000000000007371527170563500176060ustar00rootroot00000000000000 Configuration & running

This page has moved to Configuration & running.

eliom-13.0.0/doc/redirects/eliom-language.html000066400000000000000000000007251527170563500212240ustar00rootroot00000000000000 Multi-tier programming

This page has moved to Multi-tier programming.

eliom-13.0.0/doc/redirects/misc.html000066400000000000000000000006411527170563500172660ustar00rootroot00000000000000 HTML widgets

This page has moved to HTML widgets.

eliom-13.0.0/doc/redirects/mobile-apps.html000066400000000000000000000006431527170563500205450ustar00rootroot00000000000000 Mobile apps

This page has moved to Mobile apps.

eliom-13.0.0/doc/redirects/ppx-migration.html000066400000000000000000000007251527170563500211340ustar00rootroot00000000000000 Multi-tier programming

This page has moved to Multi-tier programming.

eliom-13.0.0/doc/redirects/ppx-syntax.html000066400000000000000000000007251527170563500204710ustar00rootroot00000000000000 Multi-tier programming

This page has moved to Multi-tier programming.

eliom-13.0.0/doc/redirects/scalability.html000066400000000000000000000006671527170563500206430ustar00rootroot00000000000000 Scalability

This page has moved to Scalability.

eliom-13.0.0/doc/redirects/server-links.html000066400000000000000000000007251527170563500207620ustar00rootroot00000000000000 Creating links and forms

This page has moved to Creating links and forms.

eliom-13.0.0/doc/redirects/server-outputs.html000066400000000000000000000007211527170563500213610ustar00rootroot00000000000000 Service handlers

This page has moved to Service handlers.

eliom-13.0.0/doc/redirects/server-params.html000066400000000000000000000007531527170563500211260ustar00rootroot00000000000000 Typing service parameters

This page has moved to Typing service parameters.

eliom-13.0.0/doc/redirects/server-security.html000066400000000000000000000006351527170563500215110ustar00rootroot00000000000000 Security

This page has moved to Security.

eliom-13.0.0/doc/redirects/server-services.html000066400000000000000000000007431527170563500214650ustar00rootroot00000000000000 The different types of services

This page has moved to The different types of services.

eliom-13.0.0/doc/redirects/server-state.html000066400000000000000000000006751527170563500207660ustar00rootroot00000000000000 Sessions and server side state

This page has moved to Sessions and server side state.

eliom-13.0.0/doc/redirects/workflow-configuration.html000066400000000000000000000007371527170563500230600ustar00rootroot00000000000000 Configuration & running

This page has moved to Configuration & running.

eliom-13.0.0/doc/redirects/workflow-distillery.html000066400000000000000000000006611527170563500223710ustar00rootroot00000000000000 Distillery

This page has moved to Distillery.

eliom-13.0.0/doc/server.indexdoc000066400000000000000000000010201527170563500164760ustar00rootroot00000000000000{1 Server API} {!modules: Lib Client Client_value Common Config Request_info Reference State Extension } {2 Content and form creation} {!modules: Content Content.Html Content.Svg Content.Xml Tools } {2 Service creation} {!modules: Service Parameter Eliom_uri Registration Registration.Html Registration.Action Registration.Ocaml Registration.App Registration.File Registration.Any Registration.Redirection } {2 Client/server communication} {!modules: Shared Notif Cscache Bus Comet Eliom_react } {2 Index} {!indexlist} eliom-13.0.0/doc/server/000077500000000000000000000000001527170563500147665ustar00rootroot00000000000000eliom-13.0.0/doc/server/index.mld000066400000000000000000000015201527170563500165710ustar00rootroot00000000000000@children_order services/ state security widgets @toc_status hidden {0 Server-side programming} Eliom can be used as a traditional server-side Web framework, where the server generates the pages. These chapters are also the basis of client-server applications. - {{!//server/services/page-index}Services} are the entry points of a Web site: how to create them, type their parameters, write their handlers, and link to them. - {{!//server/page-state}Sessions and server side state}: Eliom references keep data on the server for one user, one client process or a group of sessions, in memory or in a database that survives restarts. - {{!//server/page-security}Security}: what Eliom and Ocsigen Server take care of, and what is left to the programmer. - {{!//server/page-widgets}HTML widgets}: images, style sheets, scripts and menus. eliom-13.0.0/doc/server/security.mld000066400000000000000000000164141527170563500173410ustar00rootroot00000000000000@short_title Security {0 How to write secure applications with Eliom} Eliom and Ocsigen server automatically take charge of a lot of security issues. This unburdens the programmer from having to think about most common security problems. This page details various possible design flaws of Web applications, how Eliom and Ocsigen server (possibly) protects you against a possible exploitation of these flaws, and where you should be careful. {e Please help us maintain this page, by sending us any comments.} {2 HTTPS} If your Web site is using HTTP, all requests and responses may be intercepted. If you want your Web site to be secure, never send private data through HTTP: - Pages containing personal data must be sent only through HTTPS - Passwords must be sent to the server only through HTTPS - Use secure Eliom references to record user name or user ID once the user is connected, otherwise the session ID may be sent through HTTP. {2 The application only does client-side verification} This is probably the biggest (and most dangerous) possible mistake. As the user has an entire control over the data sent to the server, {b never} assume that the data sent by the client has been verified (even if some validation happens in Js_of_ocaml). Instead, reimplement all verification server-side. - As a (small) mitigating factor, Eliom automatically checks that the type of the parameters is correct. - Suggested approach: use permissions to control if the user is allowed to perform an action. Then, {ul {li when creating a form, check if the user has the required permission (if not, you will usually display a message {e insufficient permissions} instead of the form)} {li in the service that answers to the form, perform the exact same check}} However, as we are using safe unmarshaling, incorrect data will never crash the server. Example: Never trust the (current) user ID sent by the client process. Always take the userid from the session, through cookies. {2 Incorrect access controls} This typically happens if authentication is badly implemented, or altogether missing in some places. - each URL should implement user verification. Never assume that the user comes from a trusted URL, for example because the URL is secret. - use a programmatic, layered model, which encodes the various user rights (for ex: admin/moderators/editors/connected users/anonymous). Thus a compromised login will not compromise the entire application - Do not leak information through erroneous login (such as {e this login does not exist}). Always answer {e Bad login or password}, using always the same string - Do not permit too many near-simultaneous login attempts, either for the same login, or from the same IP. You can use the module Lwt_throttle to delay login, if too many connections are started. {2 {{:http://en.wikipedia.org/wiki/Code_injection}Code injection}} - Eliom modules are written in OCaml, which is a compiled language. This prevents all code injection possible with scripting languages. - No SQL injection is possible if you use a library that passes values as parameters of prepared statements, like PG'OCaml or Caqti. - No HTML injection is possible, as unsafe HTML characters are always escaped before being written. {2 {{:http://en.wikipedia.org/wiki/Directory_traversal}Path traversal}} - The module {{!/ocsigenserver/page-extendconfiguration}Extendconfiguration} can be used to prevent access to files or entire directories, from both Staticmod and Eliom. - Even if {{!/ocsigenserver/page-userconf}userconf} is activated, users can only expose their own files; see the [localpath] option for details. - Occurrences of the ['..'] pattern appearing in URLs are automatically removed by the server - Ocsigen automatically decodes the percent-encoded characters of URLs, which protects against attacks based on quoted characters {2 {{:http://en.wikipedia.org/wiki/Session_fixation}Session fixation}} - Ocsigen cookies are cryptographically generated, and cannot be guessed by the attacker. Thus the attacker cannot control, or supply, the cookie of the client. - To be completely safe, do not issue tokens to anonymous users, or issue a new token as soon as a login/logout takes place {2 {{:http://en.wikipedia.org/wiki/Cross-site_scripting}Cross-site scripting (XSS)}} - most XSS attacks require code injection, from which you are automatically protected (see above) - However, avoid at all costs to put user-supplied text in sensitive tags, including: {ul {li [" ] ] [%%server.start] let () = App.register ~service:(get ["raw-html"]) (fun () () -> let open Eliom.Content.Html in let client_raw = D.div ~a:[a_id "client-raw"] [] and client_top = D.p ~a:[a_id "client-top"] [] and client_rows = D.tbody [] and client_injected = D.div ~a:[a_id "client-injected"] [] and client_d = D.p ~a:[a_id "client-d"] [] and client_react = D.p ~a:[a_id "client-react"] [] in (* A node of the server, rebuilt by the client *) let injected = p [Unsafe.data "injected"] in let build = button ~a: [ a_id "build" ; a_onclick [%client fun _ -> let open Eliom.Content.Html in Manip.appendChildren ~%client_raw (raw_html ()); (* Raw HTML without a parent element *) Manip.appendChild ~%client_top (F.Unsafe.data "top two"); Manip.appendChild ~%client_rows (F.Unsafe.data "row"); Manip.appendChild ~%client_injected ~%injected; (* A D node of raw HTML is the element it gives, which Manip removes *) let d = D.Unsafe.data "removed" in Manip.appendChild ~%client_d d; Manip.removeSelf d; (* Raw HTML as a reactive node *) let s, set = React.S.create "0" in Manip.appendChild ~%client_react (R.node (React.S.map F.Unsafe.data s)); set "1"] ] [txt "build"] in page "raw-html" [ div ~a:[a_id "server-raw"] (raw_html ()) ; build ; client_raw ; client_top ; tablex ~a:[a_id "client-table"] [client_rows] ; client_injected ; client_d ; client_react ]) eliom-13.0.0/test/e2e/app/server.ml000066400000000000000000000016531527170563500167720ustar00rootroot00000000000000(* The server of the browser tests: [server.exe PORT STATIC_DIR DATA_DIR (js | wasm)] serves the application e2e on localhost, and its client programs from STATIC_DIR. DATA_DIR holds the logs and the persistent data. With [wasm], the page loads the WebAssembly client program in the browsers that support it. *) let () = match Sys.argv with | [|_; port; static_dir; data_dir; ("js" | "wasm") as backend|] -> Ocsipersist_settings.set_db_file (Filename.concat data_dir "ocsidb"); Ocsigen.Server.start ~ports:[`IPv4 Unix.inet_addr_loopback, int_of_string port] ~command_pipe:(Filename.concat data_dir "command") ~logdir:data_dir ~debugmode:true [ Ocsigen.Server.host [ Staticmod.run ~dir:static_dir () ; Eliom.App.run ~enable_wasm:(backend = "wasm") () ] ] | _ -> prerr_endline "usage: server.exe PORT STATIC_DIR DATA_DIR (js | wasm)"; exit 2 eliom-13.0.0/test/e2e/client-server.spec.js000066400000000000000000000062051527170563500204210ustar00rootroot00000000000000// Client and server: server functions, a bus, React events and signals of the // server, and the state of the tabs and of the session. "use strict"; const { test, expect } = require("@playwright/test"); const { open, collectGarbage } = require("./helpers"); // The bus and the counter of the server are shared by the tests test.describe.configure({ mode: "serial" }); // Clicks the button [id] of the page, which shows the result of its action async function run(page, id, result) { await page.click(`#${id}`); await expect(page.locator(`#${id}-result`)).toHaveText(result); } test("server function", async ({ page }) => { await open(page, "/client-server"); await run(page, "double", "42"); }); test("exception in a server function", async ({ page }) => { await open(page, "/client-server"); await run(page, "fail", "exception on the server"); }); test("server function returning a client value", async ({ page }) => { await open(page, "/client-server"); await run(page, "client-value", "made by a client value"); }); // [f a b] runs with the page of the application open in two browsers async function inTwoBrowsers(browser, f) { const contexts = [await browser.newContext(), await browser.newContext()]; try { const pages = await Promise.all(contexts.map((c) => c.newPage())); for (const page of pages) await open(page, "/client-server"); await f(...pages); } finally { for (const context of contexts) await context.close(); } } test("bus between two browsers", async ({ browser }) => { await inTwoBrowsers(browser, async (a, b) => { await run(a, "bus-write", "sent"); await expect(b.locator("#bus")).toHaveText("on the bus"); }); }); test("signal of the server in two browsers", async ({ browser }) => { await inTwoBrowsers(browser, async (a, b) => { const counter = b.locator("#counter-down"); await expect(counter).toHaveText(/^\d+$/); const before = Number(await counter.textContent()); for (const page of [a, b]) await collectGarbage(page); await run(a, "increment", "sent"); // The tests in other browsers can increment the counter too await expect .poll(async () => Number(await counter.textContent())) .toBeGreaterThan(before); }); }); test("event sent up to the server", async ({ page }) => { await open(page, "/client-server"); await run(page, "up", "sent"); await page.reload(); await expect(page.locator("#last-up")).toHaveText("sent up"); }); // An action answers without content (204): Client.call_service, which returns // the content of the answer, fails with Failed_request 204, which the callers // that expect an action catch, as Bus.write does. test("action of the server", async ({ page }) => { await open(page, "/client-server"); await run(page, "action", "Eliom.Request.Failed_request(204)"); }); test("state of the tabs and of the session", async ({ context }) => { const [one, two] = [await context.newPage(), await context.newPage()]; await open(one, "/client-server"); await open(two, "/client-server"); await run(one, "count", "tab 1, session 1"); await run(one, "count", "tab 2, session 2"); await run(two, "count", "tab 1, session 3"); }); eliom-13.0.0/test/e2e/dune000066400000000000000000000001661527170563500152260ustar00rootroot00000000000000; Browser tests: see playwright.config.js (dirs :standard \ node_modules test-results playwright-report server-data) eliom-13.0.0/test/e2e/forms.spec.js000066400000000000000000000060641527170563500167700ustar00rootroot00000000000000// Forms submitted by the client program (XHR) send what the browser sends // when it submits them natively (~xhr:false): the fields, the button that // submits the form, the point of an image button. A button that overrides the // action of its form makes the browser submit it natively. "use strict"; const { test, expect } = require("@playwright/test"); const { open, markDocument, sameDocument } = require("./helpers"); const modes = [ { name: "XHR", path: "forms", keepsDocument: true }, { name: "native", path: "native", keepsDocument: false }, ]; // [submit] submits a form of the page; [received] is what the server receives const cases = [ ["button B", (p) => p.click("#b"), "t=hello b=[b] n=[]"], ["Enter in a field", (p) => p.press("#t", "Enter"), "t=hello b=[a] n=[]"], [ "Enter after a click on a button that does not submit", async (p) => { await p.click("#decoy"); await p.press("#t", "Enter"); }, "t=hello b=[a] n=[]", ], ["input of type submit", (p) => p.click("#c"), "t=hello b=[c] n=[]"], ["label of a button", (p) => p.click("#d-label"), "t=hello b=[d] n=[]"], [ "requestSubmit after a click on a button that does not submit", async (p) => { await p.click("#decoy"); await p.$eval("#main-form", (f) => f.requestSubmit()); }, "t=hello b=[] n=[]", ], [ "Enter with an image button", (p) => p.press("#it", "Enter"), "t=image img=0,0", ], ]; for (const meth of ["get", "post"]) { for (const mode of modes) { test.describe(`${meth.toUpperCase()}, ${mode.name}`, () => { for (const [name, submit, received] of cases) { test(name, async ({ page }) => { await open(page, `/${mode.path}/${meth}`); await markDocument(page); await submit(page); await expect(page.locator("#received")).toHaveText(received); expect(await sameDocument(page)).toBe(mode.keepsDocument); }); } test("button with formaction", async ({ page }) => { await open(page, `/${mode.path}/${meth}`); await markDocument(page); await page.click("#elsewhere"); await expect(page).toHaveURL(/\/elsewhere\?/); await expect(page.locator("#received")).toHaveText( "t=hello b=[e] n=[]", ); expect(await sameDocument(page)).toBe(false); }); }); } // The point of an image button depends on how the browser rounds the position // of the click: the client program sends the point that the browser sends test(`${meth.toUpperCase()}, click on an image button`, async ({ page }) => { const point = async (mode) => { await open(page, `/${mode.path}/${meth}`); await markDocument(page); await page.click("#img", { position: { x: 5, y: 7 } }); const received = page.locator("#received"); await expect(received).toHaveText(/^t=image img=[4-6],[6-8]$/); expect(await sameDocument(page)).toBe(mode.keepsDocument); return received.textContent(); }; const [xhr, native] = modes; expect(await point(xhr)).toBe(await point(native)); }); } eliom-13.0.0/test/e2e/helpers.js000066400000000000000000000032231527170563500163450ustar00rootroot00000000000000// Helpers of the browser tests "use strict"; const { test, expect } = require("@playwright/test"); // Waits until the client program has handled the document loaded in [page] // (not a page changed through an XHR, which keeps the flag of the previous // one): before, a link or a form is handled natively by the browser, and the // events of the page are not handled. // Checks that the client program matches the backend of the project // (js_of_ocaml or wasm_of_ocaml): a browser without the WebAssembly features that Eliom // needs would get the JavaScript one. async function ready(page) { await page.waitForFunction(() => window.e2eReady === true); expect(await page.evaluate(() => window.e2eBackend)).toBe( test.info().project.metadata.backend, ); } // Opens [path] in [page] and waits until the client program has handled it async function open(page, path) { await page.goto(path); await ready(page); } // Runs the garbage collector of [page] when the browser lets the tests do it // (Chromium, see playwright.config.js): a React value that nothing keeps // alive then stops being updated. async function collectGarbage(page) { await page.evaluate(() => window.gc?.()); } // Marks the document shown in [page], for [sameDocument] async function markDocument(page) { await page.evaluate(() => { window.e2eDocument = true; }); } // Whether [page] still shows the document marked by [markDocument]: a new // document does not have the mark, a page loaded through an XHR keeps it function sameDocument(page) { return page.evaluate(() => window.e2eDocument === true); } module.exports = { ready, open, collectGarbage, markDocument, sameDocument }; eliom-13.0.0/test/e2e/navigation.spec.js000066400000000000000000000063471527170563500200050ustar00rootroot00000000000000// Navigation: the links of the application change the page without loading a // new document; history and reload work. "use strict"; const { test, expect } = require("@playwright/test"); const { ready, open, markDocument, sameDocument } = require("./helpers"); // Clicks the button of the main page and checks that its counter changes: // the client program handles the events of the page async function checkIncrement(page) { const counter = page.locator("#counter"); const before = Number(await counter.textContent()); await page.click("#increment"); await expect(counter).toHaveText(String(before + 1)); } // The page comes from the server through an XHR, and replaces the content of the // document (Client.set_content); the code of the new page runs at load. test("the links of the application do not load a document", async ({ page, }) => { await open(page, "/"); await expect(page.locator("#onload")).toHaveText("ran at load"); await markDocument(page); await page.click("#to-two"); await expect(page).toHaveURL(/\/two$/); await expect(page.locator("#title")).toHaveText("two"); await expect(page.locator("#two-onload")).toHaveText("ran at load"); await page.click("#to-main"); await expect(page).toHaveURL(/\/$/); await expect(page.locator("#onload")).toHaveText("ran at load"); await checkIncrement(page); expect(await sameDocument(page)).toBe(true); }); test("back and forward", async ({ page }) => { await open(page, "/"); await markDocument(page); await page.click("#to-two"); await expect(page.locator("#title")).toHaveText("two"); await page.goBack(); await expect(page).toHaveURL(/\/$/); await expect(page.locator("#title")).toHaveText("main"); expect(await sameDocument(page)).toBe(true); await checkIncrement(page); await page.goForward(); await expect(page).toHaveURL(/\/two$/); await expect(page.locator("#title")).toHaveText("two"); expect(await sameDocument(page)).toBe(true); }); test("reload loads the page again", async ({ page }) => { await open(page, "/"); await page.click("#to-two"); await expect(page.locator("#title")).toHaveText("two"); await markDocument(page); await page.reload(); await expect(page.locator("#title")).toHaveText("two"); await expect(page.locator("#two-onload")).toHaveText("ran at load"); expect(await sameDocument(page)).toBe(false); }); // A general check: the main page opens no Comet channel, unlike os_template // where an answer of Comet made the page reload itself test("the page does not reload itself", async ({ page }) => { await open(page, "/"); await expect(page.locator("#onload")).toHaveText("ran at load"); await markDocument(page); await page.waitForTimeout(2000); expect(await sameDocument(page)).toBe(true); }); test("a link to a page outside the application loads it", async ({ page }) => { await open(page, "/"); await markDocument(page); await page.click("#to-server"); await expect(page).toHaveURL(/\/server$/); await expect(page.locator("#title")).toHaveText("server"); expect(await sameDocument(page)).toBe(false); await page.goBack(); await expect(page.locator("#title")).toHaveText("main"); // Going back loads the main page again: wait for its client program await ready(page); await checkIncrement(page); }); eliom-13.0.0/test/e2e/package-lock.json000066400000000000000000000031011527170563500175540ustar00rootroot00000000000000{ "name": "e2e", "lockfileVersion": 3, "requires": true, "packages": { "": { "devDependencies": { "@playwright/test": "1.64.1" } }, "node_modules/@playwright/test": { "version": "1.64.1", "resolved": "https://registry.npmjs.org/@playwright/test/-/test-1.64.1.tgz", "integrity": "sha512-IaYGml/nSOiZWROfPtuIL7neuu9qDOZ3TNvNljUIrhDMxiGTgPjzj/g9p9RxpS2tSepPDRY+UwAaEeiKtUvIAg==", "dev": true, "license": "Apache-2.0", "dependencies": { "playwright": "1.64.1" }, "bin": { "playwright": "cli.js" }, "engines": { "node": ">=20" } }, "node_modules/playwright": { "version": "1.64.1", "resolved": "https://registry.npmjs.org/playwright/-/playwright-1.64.1.tgz", "integrity": "sha512-HCrVhHr5QQuwYoswEUGTb7gGp522yflbv/ST8nF4sFWGuLjQCt17Q/EubpGGSNKYn1tsTCPZxqHhHCfVURu7UA==", "dev": true, "license": "Apache-2.0", "dependencies": { "playwright-core": "1.64.1" }, "bin": { "playwright": "cli.js" }, "engines": { "node": ">=20" } }, "node_modules/playwright-core": { "version": "1.64.1", "resolved": "https://registry.npmjs.org/playwright-core/-/playwright-core-1.64.1.tgz", "integrity": "sha512-BC4s8y6SEVA6Q1rSxZTto8hI1KUI3xXlHGZgvGqP4IqPdI/a6FX9H29IDNz7vKo9l21b6LfYosScPL6M3xxyDQ==", "dev": true, "license": "Apache-2.0", "bin": { "playwright-core": "cli.js" }, "engines": { "node": ">=20" } } } } eliom-13.0.0/test/e2e/package.json000066400000000000000000000002601527170563500166310ustar00rootroot00000000000000{ "private": true, "description": "Browser tests of Eliom", "scripts": { "test": "playwright test" }, "devDependencies": { "@playwright/test": "1.64.1" } } eliom-13.0.0/test/e2e/playwright.config.js000066400000000000000000000047251527170563500203510ustar00rootroot00000000000000// Browser tests of Eliom. Build the application with // `dune build @test/e2e/app/all`, then run `npx playwright test` here. // E2E_BROWSERS lists the browsers (chromium by default; firefox, webkit). // Each browser runs the tests with the JavaScript client program (server on // port E2E_PORT, 8473 by default), and with the WebAssembly one (project // -wasm, server on port E2E_PORT + 1). A server keeps its logs and // persistent data in server-data/js or server-data/wasm, emptied when it // starts. "use strict"; const path = require("path"); const { defineConfig, devices } = require("@playwright/test"); const port = Number(process.env.E2E_PORT || 8473); // DUNE_BUILD_DIR is relative to the root of the repository, as for dune const app = path.join( path.resolve(__dirname, "..", "..", process.env.DUNE_BUILD_DIR || "_build"), "default", "test", "e2e", "app", ); const data = path.join(__dirname, "server-data"); const browsers = { chromium: "Desktop Chrome", firefox: "Desktop Firefox", webkit: "Desktop Safari", }; const backends = [ { suffix: "", server: "js", backend: "js_of_ocaml", port }, { suffix: "-wasm", server: "wasm", backend: "wasm_of_ocaml", port: port + 1 }, ]; const device = (name) => { if (!Object.hasOwn(browsers, name)) throw new Error( `E2E_BROWSERS: unknown browser ${JSON.stringify(name)} (${Object.keys(browsers).join(", ")})`, ); return devices[browsers[name]]; }; // The arguments, quoted for the shell const sh = (...args) => args.map((s) => `'${String(s).replace(/'/g, `'\\''`)}'`).join(" "); module.exports = defineConfig({ testDir: ".", forbidOnly: !!process.env.CI, retries: 0, projects: (process.env.E2E_BROWSERS || "chromium") .split(",") .flatMap((name) => backends.map((b) => ({ name: name + b.suffix, use: { ...device(name), baseURL: `http://127.0.0.1:${b.port}`, // Lets the tests run the garbage collector (window.gc) ...(name === "chromium" ? { launchOptions: { args: ["--js-flags=--expose-gc"] } } : {}), }, metadata: { backend: b.backend }, })), ), webServer: backends.map((b) => { const dir = path.join(data, b.server); return { command: `rm -rf ${sh(dir)} && mkdir -p ${sh(dir)} && exec ${sh(path.join(app, "server.exe"), b.port, path.join(app, "client"), dir, b.server)}`, url: `http://127.0.0.1:${b.port}/`, reuseExistingServer: false, }; }), }); eliom-13.0.0/test/e2e/raw-html.spec.js000066400000000000000000000032641527170563500173740ustar00rootroot00000000000000// Raw HTML (Unsafe.data) gives the same nodes whether the server or the // client builds the page. "use strict"; const { test, expect } = require("@playwright/test"); const { open } = require("./helpers"); test("raw HTML built by the client", async ({ page }) => { const errors = []; page.on("pageerror", (e) => errors.push(e.message)); await open(page, "/raw-html"); expect(await page.evaluate(() => window.e2eRawScripts)).toBe(1); await page.click("#build"); await expect(page.locator("#client-react")).toHaveText("1"); const server = page.locator("#server-raw"); const client = page.locator("#client-raw"); // The contents of the elements: the client gives the attributes of svg in // another order const contents = (l) => l.locator(":scope > *").evaluateAll((es) => es.map((e) => e.innerHTML)); expect(await contents(client)).toEqual(await contents(server)); await expect(client.locator("b").first()).toHaveText("bold"); // innerHTML does not show the namespace, nor whether a script contains // elements expect(await client.locator("circle").evaluate((e) => e.namespaceURI)).toBe( "http://www.w3.org/2000/svg", ); await expect(client.locator("script *")).toHaveCount(0); expect(await page.evaluate(() => window.e2eRawScripts)).toBe(2); await expect(page.locator("#client-top b")).toHaveText("top"); await expect(page.locator("#client-top i")).toHaveText("two"); await expect(page.locator("#client-table td")).toHaveText("row"); await expect(page.locator("#client-injected b")).toHaveText("injected"); await expect(page.locator("#client-d")).toBeEmpty(); await expect(page.locator("#client-react b")).toHaveText("1"); expect(errors).toEqual([]); }); eliom-13.0.0/test/e2e/smoke.spec.js000066400000000000000000000014611527170563500167540ustar00rootroot00000000000000// The page of the application: the client program starts, reads an injected // value, runs code at load, and handles events on nodes of the server. "use strict"; const { test, expect } = require("@playwright/test"); const { open } = require("./helpers"); test("the client program runs in the page", async ({ page }) => { const errors = []; page.on("pageerror", (e) => errors.push(e.message)); page.on("console", (m) => { if (m.type() === "error") errors.push(m.text()); }); await open(page, "/"); await expect(page.locator("#injection")).toHaveText("sent by the server"); await expect(page.locator("#onload")).toHaveText("ran at load"); await page.click("#increment"); await page.click("#increment"); await expect(page.locator("#counter")).toHaveText("2"); expect(errors).toEqual([]); }); eliom-13.0.0/test/ppx/000077500000000000000000000000001527170563500145015ustar00rootroot00000000000000eliom-13.0.0/test/ppx/cmo/000077500000000000000000000000001527170563500152575ustar00rootroot00000000000000eliom-13.0.0/test/ppx/cmo/client/000077500000000000000000000000001527170563500165355ustar00rootroot00000000000000eliom-13.0.0/test/ppx/cmo/client/dune000066400000000000000000000010121527170563500174050ustar00rootroot00000000000000; The client code, compiled from the binary AST as in the rules of the ; templates. (rule (target fixture.ml) (deps ../fixture.eliom %{cmo:../fixture}) (action (with-stdout-to %{target} (chdir .. (run %{bin:ppx_eliom_client} --as-pp -server-cmo %{cmo:../fixture} --impl fixture.eliom))))) (library (name eliom_ppx_test_client) (wrapped false) (modes byte) (modules fixture) (libraries eliom.client)) (rule (alias runtest) (deps %{cmo:fixture}) (action (progn))) eliom-13.0.0/test/ppx/cmo/dune000066400000000000000000000007341527170563500161410ustar00rootroot00000000000000; The server side of a fixture. The client pass (client/) reads the types of ; its server cmo with -server-cmo. Both passes run in this directory, so that ; they see the same file name. (rule (target fixture.ml) (deps fixture.eliom) (action (with-stdout-to %{target} (chdir . (run %{bin:ppx_eliom_server} --as-pp --impl fixture.eliom))))) (library (name eliom_ppx_test_server) (wrapped false) (modes byte) (modules fixture) (libraries eliom.server)) eliom-13.0.0/test/ppx/cmo/fixture.eliom000066400000000000000000000020121527170563500177670ustar00rootroot00000000000000(* Values of many types sent from the server to the client. The client pass reads their types from the server cmo; the client output must compile. *) type%shared t = A | B of int let%server i = 1 let%server l = [1; 2] let%server p = 1, "a" let%server o = Some 1. let%server v = B 1 let%server pv : [`A of int | `B] = `A 1 (* Injections. *) let%client i = ~%i + 1 let%client l = List.length ~%l let%client p = fst ~%p let%client o = ~%o let%client v = ~%v let%client pv = ~%pv (* Client values, and values sent with them. The server does not type client code: the types of client values come from their annotations. *) let%server labelled () = [%client (fun ~x ?(y = 0) () -> x + y + ~%i : x:int -> ?y:int -> unit -> int)] let%server obj () = [%client (object method m = List.length ~%l end : < m : int >)] let%server shared_type () = [%client (~%v : t)] let%server html () = [%client (Eliom.Content.Html.F.txt "a" : Html_types.txt Eliom.Content.Html.elt)] let%shared from_shared (x : int) = [%client (~%x + 1 : int)] eliom-13.0.0/test/ppx/consistency.t/000077500000000000000000000000001527170563500173045ustar00rootroot00000000000000eliom-13.0.0/test/ppx/consistency.t/app.eliom000066400000000000000000000005711527170563500211160ustar00rootroot00000000000000type%shared t = A | B of int let%server x = 1 let%server f () = [%client ~%x + 1] let%server at_load = [%client ~%x + 2] let%client injected = ~%x + 3 let%shared both = ~%x + 4 let%shared g y = [%client ~%y + 5] let%shared at_load_shared = [%client ~%x + 6] module%server M = struct let v = [%client 7] end module%shared N = struct let w = [%client 8] let i = ~%x end eliom-13.0.0/test/ppx/consistency.t/run.t000066400000000000000000000024461527170563500203030ustar00rootroot00000000000000The client must read back the data the server sends, in the same order. The server and the client outputs of the same file agree. $ ppx_eliom_server --impl app.eliom > server.ml $ ppx_eliom_client --impl app.eliom > client.ml The server sends the client values of each server section and the injections of each client section; the client reads them in the same order: $ sections () { grep -Eo "$1|$2" | sed -e "s/$1/server/" -e "s/$2/client/"; } $ sections close_server_section close_client_section < server.ml > server $ sections close_server_section open_client_section < client.ml > client $ diff server client $ cat client server client client server server client The client registers a closure for each client value created by the server: $ grep -o '}) "[^"]*"' server.ml | cut -d '"' -f 2 | sort > server $ grep -o 'register_client_closure "[^"]*"' client.ml | cut -d '"' -f 2 | sort > client $ diff server client $ cat client qWHe1U1 qWHe1U2 qWHe1U3 qWHe1U4 qWHe1U5 qWHe1U6 The client reads each injection the server sends: $ sed -En 's/^(let|and) _eliom_injected_ident_([^ ]*) = .+/\2/p' server.ml | sort > server $ grep -o '}) "[^"]*"' client.ml | cut -d '"' -f 2 | sort -u > client $ diff server client $ cat client qWHe1U1 qWHe1U2 qWHe1U3 eliom-13.0.0/test/ppx/dune000066400000000000000000000001551527170563500153600ustar00rootroot00000000000000(cram (package eliom) (deps %{bin:ppx_eliom_server} %{bin:ppx_eliom_types} %{bin:ppx_eliom_client})) eliom-13.0.0/test/ppx/error_empty_section.t/000077500000000000000000000000001527170563500210365ustar00rootroot00000000000000eliom-13.0.0/test/ppx/error_empty_section.t/run.t000066400000000000000000000003761527170563500220350ustar00rootroot00000000000000 $ ppx_eliom_server --impl test.eliom let __eliom__compilation_unit_id__e2YuTg = "e2YuTg" let () = Eliom.Syntax.set_global true [%%ocaml.error "Empty [%%shared] extension. Did you mean [%%shared.start] ?"] let () = Eliom.Syntax.set_global false eliom-13.0.0/test/ppx/error_empty_section.t/test.eliom000066400000000000000000000000131527170563500230360ustar00rootroot00000000000000[%%shared] eliom-13.0.0/test/ppx/errors.t/000077500000000000000000000000001527170563500162575ustar00rootroot00000000000000eliom-13.0.0/test/ppx/errors.t/empty_section.eliomi000066400000000000000000000000301527170563500223320ustar00rootroot00000000000000[%%shared:] val x : int eliom-13.0.0/test/ppx/errors.t/empty_section_without_colon.eliomi000066400000000000000000000000271527170563500253150ustar00rootroot00000000000000[%%client] val x : int eliom-13.0.0/test/ppx/errors.t/fragment_in_client.eliom000066400000000000000000000000661527170563500231370ustar00rootroot00000000000000let%client c = [%client 1] let%client s = [%shared 1] eliom-13.0.0/test/ppx/errors.t/injection_in_server.eliom000066400000000000000000000000251527170563500233410ustar00rootroot00000000000000let%server f x = ~%x eliom-13.0.0/test/ppx/errors.t/nested_fragment.eliom000066400000000000000000000001211527170563500224450ustar00rootroot00000000000000let%server n = [%client [%client 1]] let%server u = [%client [%client.unsafe 1]] eliom-13.0.0/test/ppx/errors.t/nested_injection.eliom000066400000000000000000000000501527170563500226250ustar00rootroot00000000000000let%server x = 1 let%client y = ~%(~%x) eliom-13.0.0/test/ppx/errors.t/nested_section.eliom000066400000000000000000000000551527170563500223140ustar00rootroot00000000000000module M = struct [%%client let x = 1] end eliom-13.0.0/test/ppx/errors.t/run.t000066400000000000000000000070621527170563500172550ustar00rootroot00000000000000Errors in the use of the Eliom syntax. Sections are only allowed at toplevel: $ ppx_eliom_server --impl nested_section.eliom File "nested_section.eliom", line 2, characters 2-22: 2 | [%%client let x = 1] ^^^^^^^^^^^^^^^^^^^^ Error: Sections are only allowed at toplevel. [1] $ ppx_eliom_client --impl nested_section.eliom File "nested_section.eliom", line 2, characters 2-22: 2 | [%%client let x = 1] ^^^^^^^^^^^^^^^^^^^^ Error: Sections are only allowed at toplevel. [1] The `.start` forms take no argument: $ ppx_eliom_server --impl start_argument.eliom let __eliom__compilation_unit_id__J85YE2 = "J85YE2" let () = Eliom.Syntax.set_global true [%%ocaml.error "The %%client.start extension doesn't accept arguments."] let () = Eliom.Syntax.set_global false $ ppx_eliom_client --impl start_argument.eliom let __eliom__compilation_unit_id__J85YE2 = "J85YE2" [%%ocaml.error "The %%client.start extension doesn't accept arguments."] Injections are only allowed in client code: $ ppx_eliom_server --impl injection_in_server.eliom File "injection_in_server.eliom", line 1, characters 17-20: 1 | let%server f x = ~%x ^^^ Error: The syntax ~% ... is not allowed inside server code. [1] $ ppx_eliom_client --impl injection_in_server.eliom File "injection_in_server.eliom", line 1, characters 17-20: 1 | let%server f x = ~%x ^^^ Error: The syntax ~% ... is not allowed inside server code. [1] Injections cannot be nested: $ ppx_eliom_server --impl nested_injection.eliom File "nested_injection.eliom", line 2, characters 17-22: 2 | let%client y = ~%(~%x) ^^^^^ Error: The syntax ~% ... can not be nested. [1] $ ppx_eliom_client --impl nested_injection.eliom File "nested_injection.eliom", line 2, characters 17-22: 2 | let%client y = ~%(~%x) ^^^^^ Error: The syntax ~% ... can not be nested. [1] The following errors are in client code, which only the client pass checks. Client code cannot create client values: $ ppx_eliom_client --impl fragment_in_client.eliom let __eliom__compilation_unit_id__f262wn = "f262wn" let c = [%ocaml.error "The syntax [%client ...] is not allowed inside client code."] let s = [%ocaml.error "The syntax [%shared ...] is not allowed inside client code."] Client values cannot be nested: $ ppx_eliom_client --impl nested_fragment.eliom | grep -Eo 'The syntax [^"]*' The syntax [%client ...] can not be nested. The syntax [%client.unsafe ...] can not be nested. In an interface, a section takes a signature, `[%%client: ...]`. The error says so when the colon is missing: $ ppx_eliom_server --intf section_without_colon.eliomi [%%ocaml.error "In an interface, a section takes a signature: [%%client: ...]."] $ ppx_eliom_client --intf section_without_colon.eliomi [%%ocaml.error "In an interface, a section takes a signature: [%%client: ...]."] An empty section without colon is reported as in an implementation: $ ppx_eliom_server --intf empty_section_without_colon.eliomi [%%ocaml.error "Empty [%%client] extension. Did you mean [%%client.start] ?"] val x : int $ ppx_eliom_client --intf empty_section_without_colon.eliomi [%%ocaml.error "Empty [%%client] extension. Did you mean [%%client.start] ?"] An empty signature section, `[%%shared:]`, is not reported, unlike an empty section in an implementation (see error_empty_section.t): $ ppx_eliom_server --intf empty_section.eliomi val x : int $ ppx_eliom_client --intf empty_section.eliomi eliom-13.0.0/test/ppx/errors.t/section_without_colon.eliomi000066400000000000000000000000271527170563500240770ustar00rootroot00000000000000[%%client val x : int] eliom-13.0.0/test/ppx/errors.t/start_argument.eliom000066400000000000000000000000331527170563500223410ustar00rootroot00000000000000[%%client.start let x = 1] eliom-13.0.0/test/ppx/fragments.t/000077500000000000000000000000001527170563500167315ustar00rootroot00000000000000eliom-13.0.0/test/ppx/fragments.t/fragments.eliom000066400000000000000000000016451527170563500217540ustar00rootroot00000000000000(* A client value created by server code. *) let%server simple () = [%client 1 + 1] (* Its type, given by an annotation. *) let%server annotated () = [%client (print_endline "x" : unit)] (* Values of the server sent with the client value. The same value used twice is sent once. *) let%server escaped x y = [%client ~%x + ~%y + ~%x] (* An expression, not only an identifier, can be sent. *) let%server escaped_expr x = [%client ~%(x + 1) * 2] (* A client value created by shared code: the client side calls the function directly. *) let%shared from_shared x = [%client ~%x + 1] (* Unsafe client values may be polymorphic. *) let%server unsafe () = [%client.unsafe fun x -> x] (* A shared value: a server value and a client value. *) let%server shared_value x = [%shared ~%x + 1] (* A toplevel binding that is not a function may create client values while the module is loaded. *) let%server at_toplevel = [%client 3] eliom-13.0.0/test/ppx/fragments.t/run.t000066400000000000000000000103751527170563500177300ustar00rootroot00000000000000Client values. The server creates a reference to a closure registered by the client, with the values sent from the server. The type pass binds each client value and each sent value to a reference whose type is inferred on the server. Without inferred types, the client uses `_`. The outputs are put on one line, to check parts of them independently of the layout. $ flat () { tr -s ' \n' ' '; } $ ppx_eliom_server --impl fragments.eliom > server.ml $ ppx_eliom_types --impl fragments.eliom > types.ml $ ppx_eliom_client --impl fragments.eliom > client.ml The server sends the identifier of each client value, with the values used in it. The same value used twice is sent once. The type of a client value comes from its annotation: $ flat < server.ml | grep -Eo '"16vYpk[0-9]+" [^:]* : [^)]*Client_value\.t' | > sed 's/Eliom\.Syntax\.//g' "16vYpk1" () : _ Eliom.Client_value.t "16vYpk2" () : unit Eliom.Client_value.t "16vYpk3" ((escaped_value (_eliom_escaped_ident_1 x)), (escaped_value (_eliom_escaped_ident_2 y))) : _ Eliom.Client_value.t "16vYpk4" (escaped_value (_eliom_escaped_ident_3 (x + 1))) : _ Eliom.Client_value.t "16vYpk5" (escaped_value (_eliom_escaped_ident_4 x)) : _ Eliom.Client_value.t "16vYpk6" () : _ Eliom.Client_value.t "16vYpk7" (escaped_value (_eliom_escaped_ident_5 x)) : _ Eliom.Client_value.t "16vYpk8" () : _ Eliom.Client_value.t Each client value goes through a function that stores it in a reference, which gives it a monomorphic type. The unsafe client value (6) does not, so it may be polymorphic. A shared value is also computed on the server: $ grep -Eo 'let _eliom_fragment_[^ ]*( y)? =|Eliom\.Shared\.Value\.create .*' server.ml let _eliom_fragment_16vYpk1 = let _eliom_fragment_16vYpk2 = let _eliom_fragment_16vYpk3 = let _eliom_fragment_16vYpk4 = let _eliom_fragment_16vYpk5 = let _eliom_fragment_16vYpk6 y = let _eliom_fragment_16vYpk7 = Eliom.Shared.Value.create (x + 1) let _eliom_fragment_16vYpk8 = The type pass stores the client values and the sent values in references: $ flat < types.ml | > grep -Eo '_eliom_[a-z_]+[0-9A-Za-z]* := \(Some ([^()]|\([^()]*\))*\)' _eliom_fragment_16vYpk1 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) _eliom_fragment_16vYpk2 := (Some (Eliom.Syntax.client_value "" 0 : unit Eliom.Client_value.t)) _eliom_escaped_ident_1 := (Some x) _eliom_escaped_ident_2 := (Some y) _eliom_fragment_16vYpk3 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) _eliom_escaped_ident_3 := (Some (x + 1)) _eliom_fragment_16vYpk4 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) _eliom_escaped_ident_4 := (Some x) _eliom_fragment_16vYpk5 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) _eliom_fragment_16vYpk6 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) _eliom_escaped_ident_5 := (Some x) _eliom_fragment_16vYpk7 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) _eliom_fragment_16vYpk8 := (Some (Eliom.Syntax.client_value "" 0 : _ Eliom.Client_value.t)) The client registers a closure for each client value, taking the sent values. A value used twice is read twice: $ flat < client.ml | > grep -Eo 'register_client_closure "[^"]*" \(fun (\(\)|[a-z_0-9]+|\([^)]*\))|get_escaped_value _eliom_escaped_ident_[0-9]+' register_client_closure "16vYpk1" (fun () register_client_closure "16vYpk2" (fun () register_client_closure "16vYpk3" (fun (_eliom_escaped_ident_1, _eliom_escaped_ident_2) get_escaped_value _eliom_escaped_ident_1 get_escaped_value _eliom_escaped_ident_2 get_escaped_value _eliom_escaped_ident_1 register_client_closure "16vYpk4" (fun _eliom_escaped_ident_3 get_escaped_value _eliom_escaped_ident_3 register_client_closure "16vYpk5" (fun _eliom_escaped_ident_4 get_escaped_value _eliom_escaped_ident_4 register_client_closure "16vYpk6" (fun () register_client_closure "16vYpk7" (fun _eliom_escaped_ident_5 get_escaped_value _eliom_escaped_ident_5 register_client_closure "16vYpk8" (fun () In shared code, the client side calls the function of the client value directly: $ flat < client.ml | grep -Eo 'let from_shared x = [^;]*[^ ;]' let from_shared x = let _eliom_escaped_ident_4 = x in _eliom_fragment_16vYpk5 _eliom_escaped_ident_4 eliom-13.0.0/test/ppx/injections.t/000077500000000000000000000000001527170563500171105ustar00rootroot00000000000000eliom-13.0.0/test/ppx/injections.t/injections.eliom000066400000000000000000000007111527170563500223030ustar00rootroot00000000000000let%server x = 1 let%server y = 2 (* Server values injected in client code are sent with the module. The same value injected twice is sent once. *) let%client from_client = ~%x + ~%y + ~%x (* An expression can be injected. *) let%client expr = ~%(x * 2) (* A qualified identifier gives its name to the injection. *) let%client qualified = ~%Stdlib.max_int (* In shared code, the server side uses the value itself. *) let%shared from_shared = ~%x + 1 eliom-13.0.0/test/ppx/injections.t/run.t000066400000000000000000000034641527170563500201100ustar00rootroot00000000000000Injections of server values in client code. The server sends the values of each client section with the module; the client reads them back in the same order. The server binds each injected value, and sends it with its number and the name of the injected identifier. In shared code, the server side uses the value itself: $ ppx_eliom_server --impl injections.eliom > server.ml $ grep -E '^(let|and) _eliom_injected_ident_|^let from_shared' server.ml let _eliom_injected_ident_xxLZGv1 = x and _eliom_injected_ident_xxLZGv2 = y let _eliom_injected_ident_xxLZGv3 = x * 2 let _eliom_injected_ident_xxLZGv4 = Stdlib.max_int let _eliom_injected_ident_xxLZGv5 = x let from_shared = _eliom_injected_ident_xxLZGv5 + 1 $ grep -Eo '\([0-9]+,$|\), (None|\(Some "[^"]*"\))\)' server.ml | > sed -E 's/^\(([0-9]+),$/\1/; s/^\), (.*)\)$/\1/' | paste -d ' ' - - 1 (Some "x") 2 (Some "y") 3 None 4 (Some "Stdlib_max_int") 5 (Some "x") The type pass stores each injected value in a reference, to infer its type: $ ppx_eliom_types --impl injections.eliom | > grep -Eo '_eliom_injected_ident_[^ ]* := \(Some .*\)|^let from_shared .*' _eliom_injected_ident_xxLZGv1 := (Some x) _eliom_injected_ident_xxLZGv2 := (Some y) _eliom_injected_ident_xxLZGv3 := (Some (x * 2)) _eliom_injected_ident_xxLZGv4 := (Some Stdlib.max_int) _eliom_injected_ident_xxLZGv5 := (Some x) let from_shared = x + 1 The client reads each injection by its number. The same value injected twice is read twice but sent once: $ ppx_eliom_client --impl injections.eliom | > grep -Eo '\?ident:(None|\(Some "[^"]*"\))|"xxLZGv[0-9]+"' | paste -d ' ' - - ?ident:(Some "x") "xxLZGv1" ?ident:(Some "y") "xxLZGv2" ?ident:(Some "x") "xxLZGv1" ?ident:None "xxLZGv3" ?ident:(Some "Stdlib_max_int") "xxLZGv4" ?ident:(Some "x") "xxLZGv5" eliom-13.0.0/test/ppx/interfaces.t/000077500000000000000000000000001527170563500170665ustar00rootroot00000000000000eliom-13.0.0/test/ppx/interfaces.t/interfaces.eliomi000066400000000000000000000004131527170563500224070ustar00rootroot00000000000000val in_server : int [%%client: val in_client : int] [%%shared: val in_shared : int] val%server let_server : int val%client let_client : int val%shared let_shared : int [%%client.start] val after_client_start : int [%%server.start] val after_server_start : int eliom-13.0.0/test/ppx/interfaces.t/run.t000066400000000000000000000010021527170563500200500ustar00rootroot00000000000000Interfaces. The server keeps the server and shared declarations, the client keeps the client and shared declarations. Sections in interfaces take a signature: `[%%client: ...]`. $ ppx_eliom_server --intf interfaces.eliomi val in_server : int val in_shared : int val let_server : int val let_shared : int val after_server_start : int $ ppx_eliom_client --intf interfaces.eliomi val in_client : int val in_shared : int val let_client : int val let_shared : int val after_client_start : int eliom-13.0.0/test/ppx/plain_ml.t/000077500000000000000000000000001527170563500165365ustar00rootroot00000000000000eliom-13.0.0/test/ppx/plain_ml.t/empty.eliom000066400000000000000000000000001527170563500207110ustar00rootroot00000000000000eliom-13.0.0/test/ppx/plain_ml.t/empty.ml000066400000000000000000000000001527170563500202140ustar00rootroot00000000000000eliom-13.0.0/test/ppx/plain_ml.t/plain.ml000066400000000000000000000000121527170563500201640ustar00rootroot00000000000000let x = 1 eliom-13.0.0/test/ppx/plain_ml.t/run.t000066400000000000000000000003541527170563500175310ustar00rootroot00000000000000A plain .ml file goes through the PPX unchanged: $ ppx_eliom_server --impl plain.ml let x = 1 An empty file is left untouched, whatever its extension: $ ppx_eliom_server --impl empty.ml $ ppx_eliom_server --impl empty.eliom eliom-13.0.0/test/ppx/sections.t/000077500000000000000000000000001527170563500165725ustar00rootroot00000000000000eliom-13.0.0/test/ppx/sections.t/internal.eliom000066400000000000000000000000441527170563500214330ustar00rootroot00000000000000let%server x = 1 let%client y = ~%x eliom-13.0.0/test/ppx/sections.t/run.t000066400000000000000000000025311527170563500175640ustar00rootroot00000000000000Toplevel code goes to the server by default. Each pass keeps the code of its sides: the server keeps the server and shared code, the client keeps the client and shared code, and the type pass, which infers the types of what the server sends to the client, keeps the server and shared code. The values defined in each output: $ defined () { grep -Eo 'let [a-z][a-z_]* =' | cut -d ' ' -f 2; } $ ppx_eliom_server --impl sections.eliom | defined default in_shared in_server let_shared let_server after_shared_start after_server_start included $ ppx_eliom_types --impl sections.eliom | defined default in_shared in_server let_shared let_server after_shared_start after_server_start included $ ppx_eliom_client --impl sections.eliom | defined in_client in_shared let_client let_shared after_client_start after_shared_start included in_module To compile Eliom itself, `-internal` refers to its modules without the `Eliom` prefix: $ ppx_eliom_server -internal --impl internal.eliom | > grep -Eo '(Eliom\.)?Syntax\.[a-z_]+' | sort -u Syntax.close_client_section Syntax.set_global Syntax.to_poly $ ppx_eliom_client -internal --impl internal.eliom | > grep -Eo '(Eliom\.)?Client_core\.[A-Za-z_.]+' | sort -u Client_core.Syntax_helpers.get_injection Client_core.Syntax_helpers.open_client_section eliom-13.0.0/test/ppx/sections.t/sections.eliom000066400000000000000000000010551527170563500214510ustar00rootroot00000000000000(* Toplevel code is server code by default. *) let default = 0 [%%client let in_client = 1] [%%shared let in_shared = 2] [%%server let in_server = 3] let%client let_client = 4 let%shared let_shared = 5 let%server let_server = 6 [%%client.start] let after_client_start = 7 [%%shared.start] let after_shared_start = 8 [%%server.start] let after_server_start = 9 [%%shared.start] (* An included structure is flattened: its items keep the current section. *) include struct let included = 10 end module%client M = struct let in_module = 11 end eliom-13.0.0/test/ppx/types_cmo.t/000077500000000000000000000000001527170563500167455ustar00rootroot00000000000000eliom-13.0.0/test/ppx/types_cmo.t/fragment.eliom000066400000000000000000000000461527170563500215770ustar00rootroot00000000000000let%server f () = [%client (1 : int)] eliom-13.0.0/test/ppx/types_cmo.t/injection.eliom000066400000000000000000000000441527170563500217540ustar00rootroot00000000000000let%server x = 1 let%client y = ~%x eliom-13.0.0/test/ppx/types_cmo.t/other.ml000066400000000000000000000000121527170563500204110ustar00rootroot00000000000000let x = 1 eliom-13.0.0/test/ppx/types_cmo.t/run.t000066400000000000000000000022371527170563500177420ustar00rootroot00000000000000The client pass reads the types inferred on the server from the server cmo given by `-server-cmo` (test/ppx/cmo tests a real one). Errors: $ ocamlc -c other.ml $ ppx_eliom_client -server-cmo missing.cmo --impl injection.eliom File "missing.cmo", line 1: Error: Eliom: Error while loading types: missing.cmo: No such file or directory [1] $ ppx_eliom_client -server-cmo other.ml --impl injection.eliom File "other.ml", line 1: Error: Eliom: Error while loading types: not an object file [1] $ ppx_eliom_client -server-cmo other.cmo --impl injection.eliom File "other.cmo", line 1: Error: Eliom: Error while loading types: no debugging information [1] A cmo of another file, compiled with debugging information, has no type for the injections and client values: $ ocamlc -g -c other.ml $ ppx_eliom_client -server-cmo other.cmo --impl injection.eliom | > grep -Eo 'Error: [^"]*' Error: Inferred type of injected ident not found. You need to regenerate other.cmo. $ ppx_eliom_client -server-cmo other.cmo --impl fragment.eliom | > grep -Eo 'Error: [^"]*' Error: Inferred type of client value not found. You need to regenerate other.cmo. eliom-13.0.0/test/ppx/types_file.t/000077500000000000000000000000001527170563500171065ustar00rootroot00000000000000eliom-13.0.0/test/ppx/types_file.t/poly.eliom000066400000000000000000000000521527170563500211150ustar00rootroot00000000000000let%server poly () = [%client raise Exit] eliom-13.0.0/test/ppx/types_file.t/poly.type_mli000066400000000000000000000002361527170563500216360ustar00rootroot00000000000000val _eliom_fragment__3O0q21 : 'eliom_inferred_type__weak1 Eliom.Client_value.t option ref val poly : unit -> 'eliom_inferred_type__weak1 Eliom.Client_value.t eliom-13.0.0/test/ppx/types_file.t/run.t000066400000000000000000000034201527170563500200760ustar00rootroot00000000000000The client pass reads the types inferred on the server from the file given by `-type`. eliomc builds this file with `ocamlc -i` on the output of the type pass, where weak type variables `'_a` become `'eliom_inferred_type__a`. The client uses these types for the injections, the sent values and the client values. Each type variable is renamed, and a warning marks the injections and sent values whose type has one. The client value of `missing` has no type in the file. The output is put on one line, to check parts of it independently of the layout: $ ppx_eliom_client -type types.type_mli --impl types.eliom | tr -s ' \n' ' ' | > grep -Eo '"N63mRt1" : [a-z]+|get_escaped_value _eliom_escaped_ident_1 : .* list|Error: [^"]*' "N63mRt1" : int get_escaped_value _eliom_escaped_ident_1 : (('an_eliom_inferred_type__weak1_1) [@ocaml.ppwarning "The type of this injected value contains a type variable that could be wrongly inferred."]) list Error: Inferred type of client value not found. You need to regenerate types.type_mli. The type of a client value must not be a type variable, unless it is unsafe: $ ppx_eliom_client -type poly.type_mli --impl poly.eliom File "poly.eliom", line 1, characters 21-41: 1 | let%server poly () = [%client raise Exit] ^^^^^^^^^^^^^^^^^^^^ Error: The types of client values must be monomorphic from its usage or from its type annotation [1] $ ppx_eliom_client -type unsafe.type_mli --impl unsafe.eliom | > grep -o "'[a-z_0-9]*eliom_inferred_type[a-z_0-9]*" 'an_eliom_inferred_type__weak1_1 A missing type file is reported: $ ppx_eliom_client -type missing.type_mli --impl types.eliom File "missing.type_mli", line 1: Error: Eliom: Error while loading types: missing.type_mli: No such file or directory [1] eliom-13.0.0/test/ppx/types_file.t/types.eliom000066400000000000000000000001701527170563500212770ustar00rootroot00000000000000let%server x = 1 let%client y = ~%x let%server length l = [%client List.length ~%l] let%server missing () = [%client 0] eliom-13.0.0/test/ppx/types_file.t/types.type_mli000066400000000000000000000005031527170563500220140ustar00rootroot00000000000000val x : int val _eliom_injected_ident_N63mRt1 : int option ref val _eliom_fragment_N63mRt1 : int Eliom.Client_value.t option ref val _eliom_escaped_ident_1 : 'eliom_inferred_type__weak1 list option ref val length : 'eliom_inferred_type__weak1 list -> int Eliom.Client_value.t val missing : unit -> int Eliom.Client_value.t eliom-13.0.0/test/ppx/types_file.t/unsafe.eliom000066400000000000000000000000631527170563500214150ustar00rootroot00000000000000let%server unsafe () = [%client.unsafe raise Exit] eliom-13.0.0/test/ppx/types_file.t/unsafe.type_mli000066400000000000000000000002401527170563500221270ustar00rootroot00000000000000val _eliom_fragment_'3efCI1 : 'eliom_inferred_type__weak1 Eliom.Client_value.t option ref val unsafe : unit -> 'eliom_inferred_type__weak1 Eliom.Client_value.t eliom-13.0.0/test/server/000077500000000000000000000000001527170563500152005ustar00rootroot00000000000000eliom-13.0.0/test/server/bus/000077500000000000000000000000001527170563500157715ustar00rootroot00000000000000eliom-13.0.0/test/server/bus/dune000066400000000000000000000006761527170563500166600ustar00rootroot00000000000000(executable (name server) (modules server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services eliom_test_client lwt_react)) (test (name test) (modules test) (package eliom) (deps server.exe) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_client alcotest)) eliom-13.0.0/test/server/bus/server.ml000066400000000000000000000070011527170563500176270ustar00rootroot00000000000000(* The test server of test.ml: buses of the site and of client processes, and events of Eliom_react, whose information is sent in JSON. *) open Eliom open Eliom_test_services module P = Parameter module Client = Eliom_test_client (* [record stream] is the list of the values received on [stream] so far, most recent first. *) let record stream = let received = ref [] in Lwt.async (fun () -> Lwt_stream.iter (fun v -> received := v :: !received) stream); received let received_service name received = string (get [name; "received"] P.unit) (fun () () -> text (String.concat "," (List.rev !received))) (* [bus ?size name ~scope] is a bus of strings, with the services /name/info, /name/write?v= and /name/received. *) let bus ?size name ~scope = let b = Bus.create ~scope ?size [%json: string] in let received = record (Bus.stream b) in string (get [name; "info"] P.unit) (fun () () -> text (Client.Bus_info.to_string (Client.Bus_info.of_bus b))); string (get [name; "write"] P.(string "v")) (fun v () -> Lwt.bind (Bus.write b v) (fun () -> text "written")); received_service name received let () = bus "site_bus" ~scope:`Site; bus "process_bus" ~scope:Common.comet_client_process_scope; bus "small_site_bus" ~scope:`Site ~size:2; bus "small_process_bus" ~scope:Common.comet_client_process_scope ~size:2 (* Events from the server to the client *) let down name ?scope () = let event, send = React.E.create () in let d = Eliom_react.Down.of_react ?scope event in string (get [name; "info"] P.unit) (fun () () -> text (Client.Comet_info.to_string (Client.React_info.of_down d))); string (get [name; "send"] P.(string "v")) (fun v () -> send v; text "sent") (* A scope of client processes of another hierarchy, with a service to discard its states *) let other_scope = `Client_process (Common.create_scope_hierarchy "other") let () = string (get ["other"; "discard"] P.unit) (fun () () -> Lwt.bind (State.discard ~scope:other_scope ()) (fun () -> text "discarded")) let () = down "down" (); down "site_down" ~scope:`Site (); down "other_down" ~scope:other_scope () (* Signals from the server to the client, with services /name/info and /name/set?v= *) let signal name ?scope () = let s, set = React.S.create "initial" in let d = Eliom_react.S.Down.of_react ?scope s in string (get [name; "info"] P.unit) (fun () () -> let info, value = Client.React_info.of_signal_down d in text (Deriving_Json.to_string [%json: string * string] (Client.Comet_info.to_string info, value))); string (get [name; "set"] P.(string "v")) (fun v () -> set v; text "set") let () = signal "signal" (); signal "site_signal" ~scope:`Site (); signal "other_signal" ~scope:other_scope () (* Events from the client to the server *) let up = Eliom_react.Up.create (P.ocaml "v" [%json: string]) let up_received = ref [] (* Kept alive: React events do not keep their dependent events. *) let () = Lwt_react.E.keep (React.E.map (fun v -> up_received := v :: !up_received) (Eliom_react.Up.to_react up)) let () = string (get ["up"; "info"] P.unit) (fun () () -> text (Client.Service_info.to_string (Client.React_info.of_up up))); received_service "up" up_received (* A full major collection, to check that nothing needed is collected *) let () = string (get ["gc"] P.unit) (fun () () -> Gc.full_major (); text "collected") let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/bus/test.ml000066400000000000000000000211701527170563500173030ustar00rootroot00000000000000(* Tests of buses and of the events of Eliom_react, through the Comet client: values written by the server or by clients reach every participant. *) open Eliom_test_server open Eliom_test_client open Lwt.Syntax module C = Comet_client let text tab url = let+ r = Tab.get tab url in if r.status <> 200 then Alcotest.failf "%s: status %d" url r.status; r.body let check_text msg expected tab url = let+ body = text tab url in Alcotest.(check string) msg expected body let values messages = List.filter_map (function _, C.Data v -> Some v | _ -> None) messages let check msg expected messages = Alcotest.(check (list string)) msg expected (values messages) let stateless_values messages = List.filter_map (function _, C.Data (v, _) -> Some v | _ -> None) messages let new_tab server = let b = Browser.create server in b, Tab.create b (* [write tab bus v] writes [v] on [bus] from the client of [tab], as the client-side program does: a list of values, in JSON. *) let write tab (bus : Bus_info.t) v = let+ r = Service_info.post tab bus.write (Deriving_Json.to_string [%json: string list] [v]) in if r.status <> 200 && r.status <> 204 then Alcotest.failf "write: status %d" r.status (* [writes tab name values] writes [values] on the bus [name] from the server *) let writes tab name values = Lwt_list.iter_s (fun v -> Lwt.map ignore (text tab ("/" ^ name ^ "/write?v=" ^ v))) values let case server name f = Alcotest.test_case name `Quick (fun () -> Lwt_main.run (f server)) let buses server = let case = case server in ( "buses" , [ case "bus of the site" (fun server -> let a, ta = new_tab server and b, tb = new_tab server in let* info = text ta "/site_bus/info" in let info = Bus_info.of_string info in let* _ = text tb "/site_bus/info" in let* _ = text ta "/site_bus/write?v=from-server" in let last = Eliom.Comet_base.Last (Some 1) in let* ma = C.request_stateless a info.channel last in let* mb = C.request_stateless b info.channel last in Alcotest.(check (list string)) "a" ["from-server"] (stateless_values ma); Alcotest.(check (list string)) "b" ["from-server"] (stateless_values mb); let* () = write ta info "from-a" in let* mb = C.request_stateless b info.channel last in Alcotest.(check (list string)) "written by a" ["from-a"] (stateless_values mb); check_text "received by the server" "from-server,from-a" ta "/site_bus/received") ; case "bus of client processes" (fun server -> (* Each client process gets its own channel, fed by the bus. *) let _, ta = new_tab server and _, tb = new_tab server in let* ia = text ta "/process_bus/info" in let ia = Bus_info.of_string ia in let* ib = text tb "/process_bus/info" in let ib = Bus_info.of_string ib in let* () = C.register ta ia.channel in let* () = C.register tb ib.channel in let* _ = text ta "/process_bus/write?v=from-server" in let* ma = C.request ta ia.channel 1 in check "a" ["from-server"] ma; let* mb = C.request tb ib.channel 1 in check "b" ["from-server"] mb; let* () = write ta ia "from-a" in let* mb = C.request tb ib.channel 2 in check "written by a" ["from-a"] mb; check_text "received by the server" "from-server,from-a" ta "/process_bus/received") ; case "size, for the site" (fun server -> let a, ta = new_tab server in let* info = text ta "/small_site_bus/info" in let info = Bus_info.of_string info in let* () = writes ta "small_site_bus" ["1"; "2"; "3"] in let* m = C.request_stateless a info.channel (Eliom.Comet_base.After 1) in (match m with | [(_, C.Full)] -> () | _ -> Alcotest.fail "full expected"); let+ m = C.request_stateless a info.channel (Eliom.Comet_base.After 2) in Alcotest.(check (list string)) "kept" ["2"; "3"] (stateless_values m)) ; case "size, for client processes" (fun server -> let _, tab = new_tab server in let* info = text tab "/small_process_bus/info" in let info = Bus_info.of_string info in let* () = C.register tab info.channel in let* () = writes tab "small_process_bus" ["1"; "2"; "3"] in let+ m = C.request tab info.channel 1 in match List.map snd m with | [C.Full] -> () | _ -> Alcotest.fail "full expected") ] ) let events server = let case = case server in ( "events" , [ case "down" (fun server -> let _, tab = new_tab server in let* info = text tab "/down/info" in let info = Comet_info.of_string info in let* () = C.register tab info in let* _ = text tab "/down/send?v=x" in let+ m = C.request tab info 1 in check "occurrence" ["x"] m) ; case "down, for the site" (fun server -> let a, ta = new_tab server and b, _ = new_tab server in let* info = text ta "/site_down/info" in let info = Comet_info.of_string info in let* _ = text ta "/gc" in let* _ = text ta "/site_down/send?v=y" in let last = Eliom.Comet_base.Last (Some 1) in let* ma = C.request_stateless a info last in let+ mb = C.request_stateless b info last in Alcotest.(check (list string)) "a" ["y"] (stateless_values ma); Alcotest.(check (list string)) "b" ["y"] (stateless_values mb)) ; case "up" (fun server -> let _, tab = new_tab server in let* info = text tab "/up/info" in let info = Service_info.of_string info in let* _ = text tab "/gc" in let* r = Service_info.post tab info (Deriving_Json.to_string [%json: string] "u") in if r.status <> 200 && r.status <> 204 then Alcotest.failf "up: status %d" r.status; check_text "received by the server" "u" tab "/up/received") ] ) (* [signal tab name] is the channel of the signal [name] and its value, as sent to [tab] *) let signal tab name = let+ s = text tab ("/" ^ name ^ "/info") in let info, value = Deriving_Json.from_string [%json: string * string] s in Comet_info.of_string info, value let set tab name v = Lwt.map ignore (text tab ("/" ^ name ^ "/set?v=" ^ v)) let signals server = let case = case server in ( "signals" , [ case "down" (fun server -> (* The value sent with the page is sent again by the first request. Values of the signal may then be skipped, but not the last one. *) let _, tab = new_tab server in let* () = set tab "signal" "a" in let* info, value = signal tab "signal" in Alcotest.(check string) "value" "a" value; let* () = C.register tab info in let* m = C.request tab info 1 in check "first request" ["a"] m; let* () = set tab "signal" "b" in let* () = set tab "signal" "c" in let+ m = C.request tab info 2 in match List.rev (values m) with | "c" :: _ -> () | _ -> Alcotest.fail "last value expected") ; case "down, for the site" (fun server -> let a, ta = new_tab server and b, _ = new_tab server in let* () = set ta "site_signal" "a" in let* info, value = signal ta "site_signal" in Alcotest.(check string) "value" "a" value; let* _ = text ta "/gc" in let* () = set ta "site_signal" "b" in let* () = set ta "site_signal" "c" in let last = Eliom.Comet_base.Last None in let* ma = C.request_stateless a info last in let+ mb = C.request_stateless b info last in Alcotest.(check (list string)) "a" ["c"] (stateless_values ma); Alcotest.(check (list string)) "b" ["c"] (stateless_values mb)) ] ) (* Channels of a scope of another hierarchy are closed with the client process of this hierarchy. *) let scopes server = let closed name info_of = case server name (fun server -> let _, tab = new_tab server in let* info = info_of tab in let* () = C.register tab info in let* _ = text tab "/other/discard" in Lwt.catch (fun () -> let+ _ = C.request ~idle:true tab info 1 in Alcotest.fail "answered") (function C.State_closed -> Lwt.return_unit | e -> Lwt.fail e)) in ( "scopes" , [ closed "down" (fun tab -> Lwt.map Comet_info.of_string (text tab "/other_down/info")) ; closed "signal" (fun tab -> Lwt.map fst (signal tab "other_signal")) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-bus" [buses server; events server; signals server; scopes server]) eliom-13.0.0/test/server/client/000077500000000000000000000000001527170563500164565ustar00rootroot00000000000000eliom-13.0.0/test/server/client/bus_info.ml000066400000000000000000000011731527170563500206160ustar00rootroot00000000000000type t = {channel : Comet_info.t; write : Service_info.t} let of_bus bus = let (channel, Eliom.Comet_base.Bus_send_service service), _unwrapper = (Page.receive bus : (_, _) Eliom.Comet_base.wrapped_bus * _) in { channel = Comet_info.of_wrapped channel ; write = Service_info.of_service service } let json = [%json: string * string] let to_string {channel; write} = Deriving_Json.to_string json (Comet_info.to_string channel, Service_info.to_string write) let of_string s = let channel, write = Deriving_Json.from_string json s in {channel = Comet_info.of_string channel; write = Service_info.of_string write} eliom-13.0.0/test/server/client/bus_info.mli000066400000000000000000000007751527170563500207760ustar00rootroot00000000000000(** What a client needs to know about a bus: the Comet channel on which it receives the values of the bus, and the service writing on the bus. Computed by the test server, sent to the test in JSON. *) type t = {channel : Comet_info.t; write : Service_info.t} val of_bus : ('a, 'b) Eliom.Bus.t -> t (** [of_bus b] is the information about [b], as sent to the client of the request. To be called by a service handler of the test server. *) val to_string : t -> string val of_string : string -> t eliom-13.0.0/test/server/client/comet_client.ml000066400000000000000000000041001527170563500214500ustar00rootroot00000000000000open Lwt.Syntax module Browser = Eliom_test_server.Browser module B = Eliom.Comet_base type 'a message = Data of 'a | Full | Closed (* Values are sent url-encoded and marshalled, wrapped for the client. *) let unmarshal s = snd (Marshal.from_string (Eliom.Lib.Url.decode s) 0 : _ * _) let message decode = function | B.Data d -> Data (decode d) | B.Full -> Full | B.Closed -> Closed exception State_closed exception Comet_error of string exception Timeout let answer (r : Browser.response) = if r.status <> 200 then Printf.ksprintf failwith "Comet: status %d" r.status; match Deriving_Json.from_string B.answer_json r.body with | B.State_closed -> raise State_closed | B.Comet_error e -> raise (Comet_error e) | B.Timeout -> raise Timeout | a -> a let params ?(idle = false) (c : Comet_info.t) request = c.post_params @ [c.request_param, Deriving_Json.to_string B.comet_request_json request] @ if idle then [c.idle_param, "on"] else [] let post ?idle tab c request = let+ r = Tab.post tab c.Comet_info.url (params ?idle c request) in answer r let commands tab c commands = let+ a = post tab c (B.Stateful (B.Commands commands)) in match a with | B.Stateful_messages [||] -> () | _ -> failwith "Comet: unexpected answer to commands" let register tab c = commands tab c [|B.Register c.Comet_info.channel|] let close tab c = commands tab c [|B.Close c.Comet_info.channel|] let request ?idle tab c n = let+ a = post ?idle tab c (B.Stateful (B.Request_data n)) in match a with | B.Stateful_messages m -> Array.to_list (Array.map (fun (id, d) -> id, message unmarshal d) m) | _ -> failwith "Comet: unexpected answer to a request of data" let request_stateless browser (c : Comet_info.t) position = let+ r = Browser.post browser c.url (params ~idle:true c (B.Stateless [|c.channel, position|])) in match answer r with | B.Stateless_messages m -> Array.to_list (Array.map (fun (id, d) -> id, message (fun (s, i) -> unmarshal s, i) d) m) | _ -> failwith "Comet: unexpected answer to a stateless request" eliom-13.0.0/test/server/client/comet_client.mli000066400000000000000000000027611527170563500216340ustar00rootroot00000000000000(** A Comet client, which requests the data of channels as the client-side program of Eliom does. *) exception State_closed (** Raised when the state of the client process of a request is closed. *) exception Comet_error of string (** Raised when the server answers with an error. *) exception Timeout (** Raised when the server answers that no data came in time. *) type 'a message = | Data of 'a (** A value sent on the channel *) | Full (** Messages were lost: the buffer of the channel was full *) | Closed (** The stream of the channel ended *) val register : Tab.t -> Comet_info.t -> unit Lwt.t (** [register t c] registers the channel [c], of the client process of [t], to be requested by [t]. *) val close : Tab.t -> Comet_info.t -> unit Lwt.t (** [close t c] tells that [t] no longer requests [c]. *) val request : ?idle:bool -> Tab.t -> Comet_info.t -> int -> (string * 'a message) list Lwt.t (** [request t c n] is the [n]th request of data of the channels registered by [t] (the Comet service of [c]), as channel identifiers and messages. It waits for data, unless [idle] is [true] (default [false]). The type of the values is the one of the channels: it is not checked. *) val request_stateless : Eliom_test_server.Browser.t -> Comet_info.t -> Eliom.Comet_base.position -> (string * ('a * int) message) list Lwt.t (** [request_stateless b c position] requests the data of the stateless channel [c] from [position], as values and their indices. *) eliom-13.0.0/test/server/client/comet_info.ml000066400000000000000000000027111527170563500211330ustar00rootroot00000000000000type t = { url : string ; post_params : (string * string) list ; idle_param : string ; request_param : string ; channel : string } let of_wrapped wrapped = let Eliom.Comet_base.Comet_service (service, _), id = match wrapped with | Eliom.Comet_base.Stateful_channel (service, id) | Eliom.Comet_base.Stateless_channel (service, id, _) -> service, id in let path, get_params, _, post_params = Eliom.Eliom_uri.make_post_uri_components_ ~absolute_path:true ~service () () in (* The parameters of coservices are prefixed. *) let _, (idle_param, request_param) = Eliom.Parameter.make_params_names (Eliom.Service.post_params_type service) in { url = Eliom.Eliom_uri.make_string_uri_from_components (path, get_params, None) ; post_params ; idle_param = Eliom.Parameter.string_of_param_name idle_param ; request_param = Eliom.Parameter.string_of_param_name request_param ; channel = Eliom.Comet_base.string_of_chan_id id } let of_channel channel = of_wrapped (Eliom.Comet.Channel.get_wrapped channel) let json = [%json: string * (string * string) list * string * string * string] let to_string {url; post_params; idle_param; request_param; channel} = Deriving_Json.to_string json (url, post_params, idle_param, request_param, channel) let of_string s = let url, post_params, idle_param, request_param, channel = Deriving_Json.from_string json s in {url; post_params; idle_param; request_param; channel} eliom-13.0.0/test/server/client/comet_info.mli000066400000000000000000000015721527170563500213100ustar00rootroot00000000000000(** What a client needs to know about a Comet channel to request its data: computed by the test server, and sent to the test in JSON. *) type t = { url : string (** The URL of the Comet service of the channel *) ; post_params : (string * string) list (** The hidden POST parameters of the service *) ; idle_param : string (** The name of the POST parameter [idle] *) ; request_param : string (** The name of the POST parameter of the request *) ; channel : string (** The identifier of the channel *) } val of_channel : 'a Eliom.Comet.Channel.t -> t (** [of_channel c] is the information about [c]. To be called by a service handler of the test server. *) val of_wrapped : 'a Eliom.Comet_base.wrapped_channel -> t (** [of_wrapped c] is the information about the channel [c] as sent to the client. *) val to_string : t -> string val of_string : string -> t eliom-13.0.0/test/server/client/dune000066400000000000000000000003251527170563500173340ustar00rootroot00000000000000; Simulations of the client side of Eliom, for the tests that run a server. (library (name eliom_test_client) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server eliom_test_server lwt)) eliom-13.0.0/test/server/client/ocaml_answer.ml000066400000000000000000000007461527170563500214710ustar00rootroot00000000000000let decode (r : Eliom_test_server.Browser.response) = if r.status <> 200 then Printf.ksprintf failwith "Ocaml_answer: status %d" r.status; if Eliom_test_server.Browser.header r "content-type" <> Some Eliom.Service.eliom_appl_answer_content_type then failwith "Ocaml_answer: not an answer of an OCaml service"; let _, data = (Marshal.from_string (Eliom.Lib.Url.decode r.body) 0 : _ * _ Eliom.Runtime.eliom_caml_service_data) in data.Eliom.Runtime.ecs_data eliom-13.0.0/test/server/client/ocaml_answer.mli000066400000000000000000000006631527170563500216400ustar00rootroot00000000000000(** The answers of the services sending OCaml values ({!Eliom.Registration.Ocaml}), such as server functions. *) val decode : Eliom_test_server.Browser.response -> [`Success of 'a | `Failure of string] (** [decode r] is the value of the answer [r], or the code of the error of the handler, which the server logs. The type of the value is not checked. @raise Failure if [r] is not the answer of such a service. *) eliom-13.0.0/test/server/client/page.ml000066400000000000000000000001411527170563500177200ustar00rootroot00000000000000let receive v = snd (Marshal.from_string (Marshal.to_string (Eliom.Wrap.wrap v) []) 0 : _ * _) eliom-13.0.0/test/server/client/page.mli000066400000000000000000000005771527170563500201060ustar00rootroot00000000000000(** Values as sent to the client in a page. *) val receive : 'a -> 'b (** [receive v] is [v] as a client receives it: wrapped for the client ({!Eliom.Wrap.wrap}), marshalled and unmarshalled. Its type depends on the wrappers inside [v]: it is not checked. To be called by a service handler of the test server, where wrapping may register services, as for a page. *) eliom-13.0.0/test/server/client/react_info.ml000066400000000000000000000014721527170563500211250ustar00rootroot00000000000000let of_down down = (* The event is sent as a channel, itself sent as its wrapped form. *) let (channel, _), _ = (Page.receive down : (_ Eliom.Comet_base.wrapped_channel * _) * _) in Comet_info.of_wrapped channel let of_up up = let service, _ = (Page.receive up : ( unit , _ , Eliom.Service.post , _ , _ , _ , _ , [`WithoutSuffix] , unit , [`One of _] Eliom.Parameter.param_name , _ ) Eliom.Service.t * _) in Service_info.of_service service let of_signal_down signal = (* The signal is sent as a channel of its changes, and its value. *) let (channel, _), value, _ = (Page.receive signal : (_ Eliom.Comet_base.wrapped_channel * _) * _ * _) in Comet_info.of_wrapped channel, value eliom-13.0.0/test/server/client/react_info.mli000066400000000000000000000011321527170563500212670ustar00rootroot00000000000000(** What a client needs to know about the events of {!Eliom.Eliom_react}, as sent to the client of the request. To be called by a service handler of the test server. *) val of_down : 'a Eliom.Eliom_react.Down.t -> Comet_info.t (** [of_down e] is the Comet channel carrying the occurrences of [e]. *) val of_up : 'a Eliom.Eliom_react.Up.t -> Service_info.t (** [of_up e] is the service triggering [e]. *) val of_signal_down : 'a Eliom.Eliom_react.S.Down.t -> Comet_info.t * 'a (** [of_signal_down s] is the Comet channel carrying the changes of [s], and the value of [s] sent with it. *) eliom-13.0.0/test/server/client/service_info.ml000066400000000000000000000021071527170563500214630ustar00rootroot00000000000000type t = {url : string; post_params : (string * string) list; param : string} let of_service service = let path, get_params, _, post_params = Eliom.Eliom_uri.make_post_uri_components_ ~absolute_path:true ~service () () in let _, param = Eliom.Parameter.make_params_names (Eliom.Service.post_params_type service) in { url = Eliom.Eliom_uri.make_string_uri_from_components (path, get_params, None) ; post_params ; param = Eliom.Parameter.string_of_param_name param } let of_server_function server_function = (* The server function is sent as its service. *) let service, _ = (Page.receive server_function : (_, _) Eliom.Client_base.server_function_service * _) in of_service service let post tab {url; post_params; param} v = Tab.post tab url (post_params @ [param, v]) let json = [%json: string * (string * string) list * string] let to_string {url; post_params; param} = Deriving_Json.to_string json (url, post_params, param) let of_string s = let url, post_params, param = Deriving_Json.from_string json s in {url; post_params; param} eliom-13.0.0/test/server/client/service_info.mli000066400000000000000000000020261527170563500216340ustar00rootroot00000000000000(** What a client needs to know about a POST service with one parameter, such as the service writing on a bus: computed by the test server, sent to the test in JSON. *) type t = { url : string (** The URL of the service *) ; post_params : (string * string) list (** The hidden POST parameters of the service *) ; param : string (** The name of the POST parameter *) } val of_service : ( unit , 'a , Eliom.Service.post , _ , _ , _ , _ , [`WithoutSuffix] , unit , [`One of 'b] Eliom.Parameter.param_name , _ ) Eliom.Service.t -> t (** [of_service s] is the information about [s]. *) val of_server_function : ('a, 'b) Eliom.Client.server_function -> t (** [of_server_function f] is the information about the service of [f], as sent to the client. *) val post : Tab.t -> t -> string -> Eliom_test_server.Browser.response Lwt.t (** [post tab s v] sends the value [v] of the parameter of [s] from [tab]. *) val to_string : t -> string val of_string : string -> t eliom-13.0.0/test/server/client/tab.ml000066400000000000000000000033571527170563500175660ustar00rootroot00000000000000open Lwt.Syntax module Browser = Eliom_test_server.Browser type t = {browser : Browser.t; mutable tab_cookies : (string * string) list} let create browser = {browser; tab_cookies = []} let tab_cookies t = t.tab_cookies let set_tab_cookies t cookies = t.tab_cookies <- cookies (* The tab cookies set by a response, as by the client-side program *) let store t (r : Browser.response) = match Browser.header r Eliom.Common_base.set_tab_cookies_header_name with | None -> () | Some json -> Ocsigen_cookie_map.Map_path.iter (fun _path cookies -> Ocsigen_cookie_map.Map_inner.iter (fun name cookie -> let others = List.remove_assoc name t.tab_cookies in t.tab_cookies <- (match cookie with | Ocsigen_cookie_map.OSet (_, value, _) -> (name, value) :: others | Ocsigen_cookie_map.OUnset -> others)) cookies) (Eliom.Cookies_base.cookieset_of_json json) let headers ?(expecting_process_page = false) t = let tab_cookies = ( Eliom.Common_base.tab_cookies_header_name , Deriving_Json.to_string [%json: (string * string) list] t.tab_cookies ) in if expecting_process_page then (* As the client-side program asking for a page of the application *) [ tab_cookies ; "Accept", "application/xhtml+xml" ; ( Eliom.Common_base.expecting_process_page_name , Deriving_Json.to_string [%json: bool] true ) ] else [tab_cookies] let get ?expecting_process_page t url = let+ r = Browser.get ~headers:(headers ?expecting_process_page t) t.browser url in store t r; r let post t url params = let+ r = Browser.post ~headers:(headers t) t.browser url params in store t r; r eliom-13.0.0/test/server/client/tab.mli000066400000000000000000000023141527170563500177270ustar00rootroot00000000000000(** Tabs of simulated browsers, as the client-side program of Eliom handles them: a tab shares the cookies of its browser, and has its own tab cookies, sent in a header of its requests and updated from a header of the responses. *) type t (** A tab. *) val create : Eliom_test_server.Browser.t -> t (** [create b] is a new tab of [b], with no tab cookie. *) val get : ?expecting_process_page:bool -> t -> string -> Eliom_test_server.Browser.response Lwt.t (** [get t url] sends a GET request for [url] from [t], as {!Eliom_test_server.Browser.get}, with the tab cookies of [t], and keeps the tab cookies set by the response. With [~expecting_process_page:true], the request asks for a page of the application, as the client-side program does when it changes page. *) val post : t -> string -> (string * string) list -> Eliom_test_server.Browser.response Lwt.t (** [post t url params] sends a POST request from [t], as {!get}. *) val tab_cookies : t -> (string * string) list (** [tab_cookies t] are the names and values of the tab cookies of [t]. *) val set_tab_cookies : t -> (string * string) list -> unit (** [set_tab_cookies t cookies] replaces the tab cookies of [t]. *) eliom-13.0.0/test/server/comet/000077500000000000000000000000001527170563500163075ustar00rootroot00000000000000eliom-13.0.0/test/server/comet/dune000066400000000000000000000005251527170563500171670ustar00rootroot00000000000000(executable (name server) (modules server) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services eliom_test_client)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_client lwt.unix alcotest)) eliom-13.0.0/test/server/comet/server.ml000066400000000000000000000044221527170563500201510ustar00rootroot00000000000000(* The test server of test.ml: Comet channels whose messages are sent by services. The information about a channel is sent in JSON (Eliom_test_client.Comet_info). *) open Eliom open Eliom_test_services open Lwt.Syntax module P = Parameter module V = Reference.Volatile module Info = Eliom_test_client.Comet_info let tab_scope = Common.default_process_scope (* Requests waiting for data are answered after 1 s. *) let () = Config.set_comet_timeout 1. (* A channel of the client process of the request, whose stream is pushed by /stateful/push and ended by /stateful/end *) let push_of_tab : (string option -> unit) option V.eref = V.eref ~scope:tab_scope None let push_to_tab v = match V.get push_of_tab with | Some push -> push v; text "pushed" | None -> text "no channel" let () = string (get ["stateful"; "create"] P.(opt (int "size"))) (fun size () -> let stream, push = Lwt_stream.create () in let channel = Comet.Channel.create ?size stream in V.set push_of_tab (Some push); text (Info.to_string (Info.of_channel channel))) let () = string (get ["stateful"; "push"] P.(string "v")) (fun v () -> push_to_tab (Some v)) let () = string (get ["stateful"; "end"] P.unit) (fun () () -> push_to_tab None) let () = string (get ["discard"] P.unit) (fun () () -> let* () = State.discard ~scope:Common.comet_client_process_scope () in text "discarded") (* Channels of the site *) let site_channel ~name create = let stream, push = Lwt_stream.create () in let channel = create stream in string (get [name; "info"] P.unit) (fun () () -> text (Info.to_string (Info.of_channel channel))); string (get [name; "push"] P.(string "v")) (fun v () -> push (Some v); text "pushed") let () = site_channel ~name:"stateless" (Comet.Channel.create ~scope:`Site ~name:"site"); site_channel ~name:"newest" (Comet.Channel.create_newest ~name:"newest") (* The channel "site", declared as a channel of another server, here the same one *) let () = let channel = Comet.Channel.external_channel ~prefix:"http://eliom-test" ~name:"site" () in string (get ["external"; "info"] P.unit) (fun () () -> text (Info.to_string (Info.of_channel channel))) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/comet/test.ml000066400000000000000000000255251527170563500176310ustar00rootroot00000000000000(* Tests of Comet channels, requested by a native client as the client-side program of Eliom does. Requests of data that expect none are idle: the test server answers a waiting request after 1 s. *) open Eliom_test_server open Eliom_test_client open Lwt.Syntax module C = Comet_client let text tab url = let+ r = Tab.get tab url in if r.status <> 200 then Alcotest.failf "%s: status %d" url r.status; r.body let message = Alcotest.testable (fun fmt -> function | C.Data s -> Format.fprintf fmt "Data %S" s | C.Full -> Format.fprintf fmt "Full" | C.Closed -> Format.fprintf fmt "Closed") ( = ) (* [check msg expected messages] checks the messages of one channel. *) let check msg expected messages = Alcotest.(check (list message)) msg expected (List.map snd messages) (* A new tab of a new browser, with a new channel of its client process, registered *) let channel ?size server = let tab = Tab.create (Browser.create server) in let* info = text tab ("/stateful/create" ^ match size with Some s -> "?size=" ^ string_of_int s | None -> "") in let info = Comet_info.of_string info in let+ () = C.register tab info in tab, info (* [raises msg exn p] checks that the request [p ()] fails with [exn]. *) let raises msg exn p = Lwt.catch (fun () -> let+ _ = p () in Alcotest.failf "%s: answered" msg) (fun e -> if e = exn then Lwt.return_unit else Lwt.fail e) let push tab v = Lwt.map ignore (text tab ("/stateful/push?v=" ^ v)) let case server name f = Alcotest.test_case name `Quick (fun () -> Lwt_main.run (f server)) let stateful server = let case = case server in ( "stateful" , [ case "messages in order" (fun server -> let* tab, info = channel server in let* () = push tab "a" in let* () = push tab "b" in let* m = C.request tab info 1 in check "first request" [C.Data "a"; C.Data "b"] m; let* () = push tab "c" in let+ m = C.request tab info 2 in check "second request" [C.Data "c"] m) ; case "no data" (fun server -> let* tab, info = channel server in let+ m = C.request ~idle:true tab info 1 in check "idle request" [] m) ; case "waiting request" (fun server -> (* A request without data waits for the next message. *) let* tab, info = channel server in let+ m, () = Lwt.both (C.request tab info 1) (let* () = Lwt_unix.sleep 0.2 in push tab "late") in check "woken up" [C.Data "late"] m) ; case "same request number" (fun server -> (* A request sent again gets the same answer. *) let* tab, info = channel server in let* () = push tab "a" in let* m = C.request tab info 1 in check "first" [C.Data "a"] m; let+ m = C.request ~idle:true tab info 1 in check "again" [C.Data "a"] m) ; case "tabs" (fun server -> let* t1, i1 = channel server in let* t2, i2 = channel server in let* () = push t1 "for t1" in let* m = C.request ~idle:true t2 i2 1 in check "other tab" [] m; let+ m = C.request t1 i1 1 in check "own tab" [C.Data "for t1"] m) ; case "full buffer" (fun server -> let* tab, info = channel ~size:2 server in let* () = push tab "a" in let* () = push tab "b" in let* () = push tab "c" in let+ m = C.request tab info 1 in check "full" [C.Full] m) ; case "close" (fun server -> let* tab, info = channel server in let* () = C.close tab info in let* () = push tab "a" in let+ m = C.request ~idle:true tab info 1 in check "not sent" [] m) ; case "closed client process" (fun server -> let* tab, info = channel server in let* _ = text tab "/discard" in raises "request" C.State_closed (fun () -> C.request ~idle:true tab info 1)) ; case "other browser" (fun server -> (* The service of the channel is registered for its client process only. *) let* _, info = channel server in let other = Tab.create (Browser.create server) in raises "request" C.State_closed (fun () -> C.request ~idle:true other info 1)) ; case "timeout" (fun server -> let* tab, info = channel server in let start = Unix.gettimeofday () in let+ () = raises "request" C.Timeout (fun () -> C.request tab info 1) in let d = Unix.gettimeofday () -. start in (* The test server answers after 1 s. *) if d < 0.8 || d > 5. then Alcotest.failf "answered after %.2f s" d) ; case "unknown channel" (fun server -> (* The channel may be created later: it is waited for. *) let* tab, info = channel server in let unknown = {info with channel = info.channel ^ "-unknown"} in let* () = C.register tab unknown in let+ m = C.request ~idle:true tab unknown 1 in check "no data" [] m) ] ) let stateless server = let site name = let b = Browser.create server in let tab = Tab.create b in let+ info = text tab ("/" ^ name ^ "/info") in b, tab, Comet_info.of_string info in let values = List.map (fun (_, m) -> match m with C.Data (v, _) -> Some v | _ -> None) in let case = case server in ( "stateless" , [ case "several clients" (fun _ -> let* a, tab, info = site "stateless" in let* b, _, _ = site "stateless" in let* _ = text tab "/stateless/push?v=x" in let* _ = text tab "/stateless/push?v=y" in let* ma = C.request_stateless a info (Eliom.Comet_base.Last (Some 2)) in let+ mb = C.request_stateless b info (Eliom.Comet_base.Last (Some 2)) in Alcotest.(check (list (option string))) "a" [Some "x"; Some "y"] (values ma); Alcotest.(check (list (option string))) "b" [Some "x"; Some "y"] (values mb)) ; case "after an index" (fun _ -> let* a, tab, info = site "stateless" in let* _ = text tab "/stateless/push?v=z" in let* m = C.request_stateless a info (Eliom.Comet_base.Newest 1) in match m with | [(_, C.Data ("z", i))] -> let* _ = text tab "/stateless/push?v=w" in (* From the index after the last message received *) let+ m = C.request_stateless a info (Eliom.Comet_base.After (i + 1)) in Alcotest.(check (list (option string))) "next" [Some "w"] (values m) | _ -> Alcotest.fail "last message expected") ; case "last messages" (fun _ -> let* a, tab, info = site "stateless" in let* _ = text tab "/stateless/push?v=p" in let* _ = text tab "/stateless/push?v=q" in let+ m = C.request_stateless a info (Eliom.Comet_base.Last (Some 1)) in Alcotest.(check (list (option string))) "last" [Some "q"] (values m)) ; case "newest" (fun _ -> (* Only the last message is kept. *) let* a, tab, info = site "newest" in let* _ = text tab "/newest/push?v=1" in let* _ = text tab "/newest/push?v=2" in let+ m = C.request_stateless a info (Eliom.Comet_base.Last (Some 5)) in Alcotest.(check (list (option string))) "last" [Some "2"] (values m)) ; case "timeout" (fun _ -> (* No message comes after this index: answered with no data *) let* a, _, info = site "stateless" in let+ m = C.request_stateless a info (Eliom.Comet_base.After max_int) in Alcotest.(check (list (option string))) "no data" [] (values m)) ; case "unknown channel" (fun _ -> let* a, _, info = site "stateless" in let unknown = {info with channel = info.channel ^ "-unknown"} in let+ m = C.request_stateless a unknown (Eliom.Comet_base.Last (Some 1)) in match m with | [(id, C.Closed)] when id = unknown.channel -> () | _ -> Alcotest.fail "closed expected") ; case "external channel" (fun _ -> (* The channel "stateless", declared as a channel of another server *) let* a, tab, info = site "stateless" in let* ext = text tab "/external/info" in let ext = Comet_info.of_string ext in Alcotest.(check string) "url" ("http://eliom-test" ^ info.url) ext.url; Alcotest.(check (list (pair string string))) "hidden parameters" info.post_params ext.post_params; Alcotest.(check string) "idle" info.idle_param ext.idle_param; Alcotest.(check string) "request" info.request_param ext.request_param; Alcotest.(check string) "channel" info.channel ext.channel; let* _ = text tab "/stateless/push?v=e" in let+ m = C.request_stateless a {ext with url = info.url} (Eliom.Comet_base.Last (Some 1)) in Alcotest.(check (list (option string))) "last" [Some "e"] (values m)) ] ) (* Requests that the client-side program does not send *) let errors server = let module B = Eliom.Comet_base in let post tab (c : Comet_info.t) params = Tab.post tab c.url (c.post_params @ params) in let request (c : Comet_info.t) r = [c.request_param, Deriving_Json.to_string B.comet_request_json r] in let status msg expected (r : Browser.response) = Alcotest.(check int) msg expected r.status in let comet_error msg (r : Browser.response) = status msg 200 r; match Deriving_Json.from_string B.answer_json r.body with | B.Comet_error _ -> () | _ -> Alcotest.failf "%s: Comet_error expected" msg in let stateless tab = let+ info = text tab "/stateless/info" in Comet_info.of_string info in let case = case server in ( "errors" , [ case "stateless, without parameters" (fun server -> let tab = Tab.create (Browser.create server) in let* info = stateless tab in let+ r = Tab.get tab info.url in comet_error "answer" r) ; case "stateless, malformed" (fun server -> (* Typing error of the parameters *) let tab = Tab.create (Browser.create server) in let* info = stateless tab in let+ r = post tab info [info.request_param, "garbage"] in status "status" 400 r) ; case "stateless, stateful request" (fun server -> let tab = Tab.create (Browser.create server) in let* info = stateless tab in let+ r = post tab info (request info (B.Stateful (B.Request_data 1))) in comet_error "answer" r) ; case "stateful, malformed" (fun server -> let* tab, info = channel server in let+ r = post tab info [info.request_param, "garbage"] in status "status" 400 r) ; case "stateful, stateless request" (fun server -> let* tab, info = channel server in let+ r = post tab info (request info (B.Stateless [||])) in comet_error "answer" r) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-comet" [stateful server; stateless server; errors server]) eliom-13.0.0/test/server/cookie_jar/000077500000000000000000000000001527170563500173055ustar00rootroot00000000000000eliom-13.0.0/test/server/cookie_jar/dune000066400000000000000000000001331527170563500201600ustar00rootroot00000000000000(test (name test) (package eliom) (libraries eliom_test_server ocsigenserver alcotest)) eliom-13.0.0/test/server/cookie_jar/test.ml000066400000000000000000000111451527170563500206200ustar00rootroot00000000000000(* Tests of the cookie jar of the simulated browsers, with an explicit clock. *) open Eliom_test_server let now = 1000. (* [jar ?now ~path set_cookies] is the empty jar with [set_cookies], received for [path] at [now]. *) let jar ?(now = now) ~path set_cookies = Cookie_jar.store ~now ~path set_cookies Cookie_jar.empty let check_header ?(now = now) msg expected ~path j = Alcotest.(check (option string)) msg expected (Cookie_jar.header ~now ~path j) let test_dates () = Alcotest.(check (option (float 0.))) "epoch" (Some 0.) (Cookie_jar.parse_date "Thu, 01 Jan 1970 00:00:00 GMT"); (* Dates written by Ocsigen Server, around leap days and centuries *) List.iter (fun t -> let s = Ocsigen_base.Lib.Date.to_string t in Alcotest.(check (option (float 0.))) s (Some t) (Cookie_jar.parse_date s)) [ 951782400. (* 2000-02-29 *) ; 951868800. (* 2000-03-01 *) ; 1709164799. (* 2024-02-28 23:59:59 *) ; 1790512496. (* 2026-09-27 12:34:56 *) ; 4107542400. (* 2100-03-01 *) ]; List.iter (fun s -> Alcotest.(check (option (float 0.))) s None (Cookie_jar.parse_date s)) ["tomorrow"; "Thu, 01 Foo 1970 00:00:00 GMT"; "Thu, 01 Jan 1970 00:00"] let test_paths () = let j = jar ~path:"/" ["a=1; Path=/foo"] in check_header "same path" (Some "a=1") ~path:"/foo" j; check_header "sub path" (Some "a=1") ~path:"/foo/bar" j; check_header "prefix, not a sub path" None ~path:"/foobar" j; check_header "parent" None ~path:"/" j; let j = jar ~path:"/" ["a=1; Path=/foo/"] in check_header "with a slash, sub path" (Some "a=1") ~path:"/foo/bar" j; check_header "with a slash, without" None ~path:"/foo" j let test_default_path () = (* The directory of the request *) let j = jar ~path:"/a/b/c" ["a=1"] in check_header "directory" (Some "a=1") ~path:"/a/b" j; check_header "sub path" (Some "a=1") ~path:"/a/b/x" j; check_header "parent" None ~path:"/a" j; let j = jar ~path:"/a/b/c" ["a=1; Path="; "b=2; Path=rel"] in check_header "empty or relative" (Some "a=1; b=2") ~path:"/a/b" j; check_header "empty or relative, parent" None ~path:"/a" j; check_header "at the root" (Some "a=1") ~path:"/" (jar ~path:"/x" ["a=1"]) let test_expiry () = let past = "Thu, 01 Jan 1970 00:00:00 GMT" in let j = jar ~path:"/" ["a=1; Path=/"; "b=2; Path=/"] in let j = Cookie_jar.store ~now ~path:"/" ["a=; Path=/; Expires=" ^ past] j in check_header "removed by expires" (Some "b=2") ~path:"/" j; let j = Cookie_jar.store ~now ~path:"/" ["b=; Path=/; Max-Age=0"] j in check_header "removed by max-age" None ~path:"/" j; let j = jar ~path:"/" ["a=1; Path=/; Max-Age=10"] in check_header "before max-age" (Some "a=1") ~now:(now +. 9.) ~path:"/" j; check_header "after max-age" None ~now:(now +. 10.) ~path:"/" j; Alcotest.(check (list (pair string string))) "not listed after max-age" [] (Cookie_jar.cookies ~now:(now +. 10.) j); (* Max-Age takes precedence over Expires, in any order *) let j = jar ~path:"/" [ "a=1; Path=/; Max-Age=10; Expires=" ^ past ; "b=2; Path=/; Expires=" ^ past ^ "; Max-Age=10" ] in check_header "max-age first" (Some "a=1; b=2") ~path:"/" j; (* A wrong Max-Age is ignored. *) check_header "wrong max-age" (Some "a=1") ~now:(now +. 1e6) ~path:"/" (jar ~path:"/" ["a=1; Path=/; Max-Age=0x10"]) let test_replacement () = let j = jar ~path:"/" ["a=1; Path=/"; "b=2; Path=/"; "a=3; Path=/x"] in let j = Cookie_jar.store ~now ~path:"/" ["a=4; Path=/"] j in (* The longer paths first, then the order of creation *) check_header "replaced in place" (Some "a=3; a=4; b=2") ~path:"/x" j; Alcotest.(check (list (pair string string))) "cookies" ["a", "3"; "a", "4"; "b", "2"] (Cookie_jar.cookies ~now j) let test_attributes () = check_header "last path" (Some "a=1") ~path:"/y" (jar ~path:"/" ["a=1; Path=/x; Path=/y"]); check_header "case of names" (Some "a=1") ~path:"/y" (jar ~path:"/" ["a=1; pATh=/y"]); check_header "secure" None ~path:"/" (jar ~path:"/" ["a=1; Path=/; Secure"]); check_header "no name or no value" None ~path:"/" (jar ~path:"/" ["novalue; Path=/"; "=x; Path=/"]); check_header "empty value" (Some "a=") ~path:"/" (jar ~path:"/" ["a=; Path=/"]) let () = Alcotest.run "eliom-cookie-jar" [ ( "cookie jar" , [ Alcotest.test_case "dates" `Quick test_dates ; Alcotest.test_case "paths" `Quick test_paths ; Alcotest.test_case "default path" `Quick test_default_path ; Alcotest.test_case "expiry" `Quick test_expiry ; Alcotest.test_case "replacement" `Quick test_replacement ; Alcotest.test_case "attributes" `Quick test_attributes ] ) ] eliom-13.0.0/test/server/coservices/000077500000000000000000000000001527170563500173455ustar00rootroot00000000000000eliom-13.0.0/test/server/coservices/dune000066400000000000000000000004551527170563500202270ustar00rootroot00000000000000(executable (name server) (modules server) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server eliom_test_client ocsipersist-sqlite uri alcotest)) eliom-13.0.0/test/server/coservices/server.ml000066400000000000000000000126451527170563500212150ustar00rootroot00000000000000(* The test server of test.ml: coservices of global scope. The handlers answer in plain text. *) open Eliom open Eliom_test_services module P = Parameter (* A fallback says whether it replaces a coservice not found. *) let fallback name = let service = Service.create ~path:(Service.Path [name]) ~meth:(Service.Get P.unit) () in string service (fun () () -> text (if Request_info.get_link_too_old () then name ^ ", link too old" else name)); service let main = fallback "main" let other = fallback "other" (* Attached coservices *) let anonymous = Service.create_attached_get ~fallback:main ~get_params:P.unit () let () = string anonymous (fun () () -> text "anonymous") let named = Service.create_attached_get ~name:"named" ~fallback:main ~get_params:P.(int "n") () (* The GET parameters without the prefix of the coservice are left to the page. *) let () = string named (fun n () -> text (String.concat " " (("named " ^ string_of_int n) :: List.map (fun (n, v) -> n ^ "=" ^ v) (Request_info.get_other_get_params ())))) let attached_post = Service.create_attached_post ~fallback:main ~post_params:P.(string "v") () let () = string attached_post (fun () v -> text ("attached post " ^ v)) let once = Service.create_attached_get ~max_use:1 ~fallback:main ~get_params:P.unit () let () = string once (fun () () -> text "once") (* Non-attached coservices *) let na_anonymous = Service.create ~path:Service.No_path ~meth:(Service.Get P.unit) () let () = string na_anonymous (fun () () -> text "na anonymous") let na_named = Service.create ~name:"na_named" ~path:Service.No_path ~meth:(Service.Get P.(int "n")) () let () = string na_named (fun n () -> text ("na named " ^ string_of_int n)) let na_post = Service.create ~path:Service.No_path ~meth:(Service.Post (P.unit, P.(string "v"))) () let () = string na_post (fun () v -> text ("na post " ^ v)) let na_once = Service.create ~max_use:1 ~path:Service.No_path ~meth:(Service.Get P.unit) () let () = string na_once (fun () () -> text "na once") (* A non-attached coservice attached to the path of another service *) let na_attached = Service.attach ~fallback:other ~service:na_named () (* CSRF-safe coservices, registered for the whole site: each link to one registers a new coservice of the session of the request (the default [~csrf_scope]), or of its client process *) let csrf = Service.create_attached_get ~csrf_safe:true ~fallback:main ~get_params:P.unit () let () = string csrf (fun () () -> text "csrf") let csrf_once = Service.create_attached_get ~csrf_safe:true ~max_use:1 ~fallback:main ~get_params:P.unit () let () = string csrf_once (fun () () -> text "csrf once") let csrf_post = Service.create_attached_post ~csrf_safe:true ~fallback:main ~post_params:P.(string "v") () let () = string csrf_post (fun () v -> text ("csrf post " ^ v)) let na_csrf = Service.create ~csrf_safe:true ~path:Service.No_path ~meth:(Service.Get P.unit) () let () = string na_csrf (fun () () -> text "na csrf") let na_csrf_post = Service.create ~csrf_safe:true ~path:Service.No_path ~meth:(Service.Post (P.unit, P.(string "v"))) () let () = string na_csrf_post (fun () v -> text ("na csrf post " ^ v)) let csrf_tab = Service.create_attached_get ~csrf_safe:true ~csrf_scope:Common.default_process_scope ~fallback:main ~get_params:P.unit () let () = string csrf_tab (fun () () -> text "csrf of the tab") (* Links to the coservices. The URL of a POST service is followed by its POST parameters, one per line, the name and the value separated by a tab. *) let get_uri service params = Eliom_uri.make_string_uri ~absolute_path:true ~service params let post_uri service post_params = let path, get_params, _, post_params = Eliom_uri.make_post_uri_components ~absolute_path:true ~service () post_params in String.concat "\n" (Eliom_uri.make_string_uri_from_components (path, get_params, None) :: List.map (fun (n, v) -> n ^ "\t" ^ v) post_params) (* Coservices created by a request, with the options [~max_use] or [~timeout] *) let create_coservice ?max_use ?timeout () = let service = Service.create_attached_get ?max_use ?timeout ~fallback:main ~get_params:P.unit () in string service (fun () () -> text "created"); get_uri service () let () = string (Service.create ~path:(Service.Path ["link"]) ~meth:(Service.Get P.(string "to")) ()) (fun target () -> text (match target with | "anonymous" -> get_uri anonymous () | "named" -> get_uri named 3 | "attached_post" -> post_uri attached_post "x" | "once" -> get_uri once () | "na_anonymous" -> get_uri na_anonymous () | "na_named" -> get_uri na_named 4 | "na_post" -> post_uri na_post "y" | "na_once" -> get_uri na_once () | "na_attached" -> get_uri na_attached 5 | "created_once" -> create_coservice ~max_use:1 () | "created_timeout" -> create_coservice ~timeout:1. () | "csrf" -> get_uri csrf () | "csrf_once" -> get_uri csrf_once () | "csrf_post" -> post_uri csrf_post "x" | "na_csrf" -> get_uri na_csrf () | "na_csrf_post" -> post_uri na_csrf_post "y" | "csrf_tab" -> get_uri csrf_tab () | _ -> invalid_arg target)) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/coservices/test.ml000066400000000000000000000227431527170563500206660ustar00rootroot00000000000000open Eliom_test_server open Helpers open Lwt.Syntax (* [link b target] is the URL of the coservice [target] and, for a POST coservice, its POST parameters, as given by the service /link of the server. *) let link b target = let+ r = Browser.get b ("/link?to=" ^ target) in match String.split_on_char '\n' r.body with | url :: params -> ( url , List.map (fun p -> match String.index_opt p '\t' with | Some i -> String.sub p 0 i, String.sub p (i + 1) (String.length p - i - 1) | None -> Alcotest.failf "wrong POST parameter %S" p) params ) | [] -> Alcotest.failf "no link to %s" target let get_link b target = Lwt.map fst (link b target) (* [on_path path url] is [url], a link to a non-attached coservice given by /link, on [path] and without the parameter of /link. *) let on_path path url = let uri = Uri.of_string url in Uri.path_and_query (Uri.with_path (Uri.remove_query_param uri "to") path) let attached server = let case = case server in ( "attached" , [ case "anonymous" (fun b -> let* url = get_link b "anonymous" in Alcotest.(check string) "path of the fallback" "/main" (Uri.path (Uri.of_string url)); let* r = Browser.get b url in check_response "first call" ~status:200 ~body:"anonymous" r; let+ r = Browser.get b url in check_response "second call" ~status:200 ~body:"anonymous" r) ; case "fallback" (fun b -> let* r = Browser.get b "/main" in check_response "without coservice" ~status:200 ~body:"main" r; let* r = Browser.get b "/main?__eliom_n__=unknown" in check_response "unknown anonymous coservice" ~status:200 ~body:"main, link too old" r; let+ r = Browser.get b "/main?__eliom__=unknown" in check_response "unknown named coservice" ~status:200 ~body:"main, link too old" r) ; case "named" (fun b -> (* The URL of a named coservice can be written by hand. *) let* r = Browser.get b "/main?__eliom__=named&__co_eliom_n=1" in check_response "by hand" ~status:200 ~body:"named 1" r; let* url = get_link b "named" in let+ r = Browser.get b url in check_response "generated" ~status:200 ~body:"named 3" r) ; case "parameters" (fun b -> let* r = Browser.get b "/main?__eliom__=named&__co_eliom_n=x" in check_response "wrong type" ~status:400 r; (* Without its parameters, the coservice is not found. *) let* r = Browser.get b "/main?__eliom__=named" in check_response "missing" ~status:200 ~body:"main, link too old" r; let+ r = Browser.get b "/main?__eliom__=named&__co_eliom_n=1&z=2" in check_response "other parameters" ~status:200 ~body:"named 1 z=2" r) ; case "POST" (fun b -> let* url, params = link b "attached_post" in let* r = Browser.post b url params in check_response "coservice" ~status:200 ~body:"attached post x" r; let* r = Browser.get b url in check_response "GET" ~status:200 ~body:"main" r; let+ r = Browser.post b url (List.map (fun (n, v) -> n, if n = "__eliom_np__" then "unknown" else v) params) in check_response "unknown coservice" ~status:200 ~body:"main, link too old" r) ] ) let non_attached server = let case = case server in ( "non-attached" , [ case "anonymous" (fun b -> let* url = get_link b "na_anonymous" in (* A link to the current page *) Alcotest.(check string) "path of the page" "/link" (Uri.path (Uri.of_string url)); let* r = Browser.get b url in check_response "current page" ~status:200 ~body:"na anonymous" r; let* r = Browser.get b (on_path "/main" url) in check_response "another page" ~status:200 ~body:"na anonymous" r; let+ r = Browser.get b (on_path "/nowhere" url) in check_response "no page" ~status:200 ~body:"na anonymous" r) ; case "named" (fun b -> let* r = Browser.get b "/nowhere?__eliom_na__name=na_named&__na_eliom_n=1" in check_response "by hand" ~status:200 ~body:"na named 1" r; let* url = get_link b "na_named" in let* r = Browser.get b url in check_response "generated" ~status:200 ~body:"na named 4" r; let+ r = Browser.get b "/main?__eliom_na__name=na_named&__na_eliom_n=x" in check_response "wrong type" ~status:400 r) ; case "POST" (fun b -> let* url, params = link b "na_post" in let+ r = Browser.post b url params in check_response "coservice" ~status:200 ~body:"na post y" r) ; case "unknown" (fun b -> (* The service of the page is used instead. *) let* r = Browser.get b "/main?__eliom_na__num=unknown" in check_response "anonymous" ~status:200 ~body:"main, link too old" r; let* r = Browser.get b "/main?__eliom_na__name=unknown" in check_response "named" ~status:200 ~body:"main, link too old" r; let* r = Browser.post b "/main" ["__eliom_na__num", "unknown"] in check_response "POST" ~status:200 ~body:"main, link too old" r; let+ r = Browser.get b "/nowhere?__eliom_na__num=unknown" in check_response "no page" ~status:404 r) ; case "attached to a path" (fun b -> let* url = get_link b "na_attached" in Alcotest.(check string) "path" "/other" (Uri.path (Uri.of_string url)); let+ r = Browser.get b url in check_response "coservice" ~status:200 ~body:"na named 5" r) ; case "before attached coservices" (fun b -> let+ r = Browser.get b "/main?__eliom_na__name=na_named&__na_eliom_n=1&__eliom_n__=unknown" in check_response "non-attached" ~status:200 ~body:"na named 1" r) ] ) (* [calls b url bodies] calls [url] once for each element of [bodies], and checks the answers. *) let calls b url bodies = Lwt_list.iteri_s (fun i body -> let+ r = Browser.get b url in check_response (Printf.sprintf "call %d" (i + 1)) ~status:200 ~body r) bodies let limits server = let case ?speed = case ?speed server in ( "limits" , [ case "max_use, attached" (fun b -> let* url = get_link b "once" in calls b url ["once"; "main, link too old"]) ; case "max_use, non-attached" (fun b -> let* url = get_link b "na_once" in calls b (on_path "/main" url) ["na once"; "main, link too old"]) ; case "created by a request" (fun b -> let* url = get_link b "created_once" in calls b url ["created"; "main, link too old"]) ; case ~speed:`Slow "timeout" (fun b -> (* 1 s after the creation or the last call *) let* url = get_link b "created_timeout" in let* () = calls b url ["created"] in let* () = Lwt_unix.sleep 0.5 in let* () = calls b url ["created"] in let* () = Lwt_unix.sleep 0.5 in let* () = calls b url ["created"] in let* () = Lwt_unix.sleep 1.5 in calls b url ["main, link too old"]) ] ) (* Each link to a CSRF-safe coservice is a new coservice of the session of the request, which an attacker cannot know nor use from another browser. *) let csrf_safe server = let case = case server in let too_old = "main, link too old" in ( "CSRF-safe" , [ case "a coservice for each link" (fun b -> let* first = get_link b "csrf" in let* second = get_link b "csrf" in Alcotest.(check bool) "new coservice" true (first <> second); let* () = calls b first ["csrf"] in calls b second ["csrf"]) ; case "of the session of the link" (fun b -> let* url = get_link b "csrf" in let* () = calls (Browser.create server) url [too_old] in calls b url ["csrf"]) ; case "max_use" (fun b -> let* url = get_link b "csrf_once" in calls b url ["csrf once"; too_old]) ; case "POST" (fun b -> let* url, params = link b "csrf_post" in let* r = Browser.post (Browser.create server) url params in check_response "other browser" ~status:200 ~body:too_old r; let+ r = Browser.post b url params in check_response "own browser" ~status:200 ~body:"csrf post x" r) ; case "non-attached" (fun b -> let* url = get_link b "na_csrf" in let url = on_path "/main" url in let* () = calls (Browser.create server) url [too_old] in calls b url ["na csrf"]) ; case "non-attached, POST" (fun b -> let* url, params = link b "na_csrf_post" in let url = on_path "/main" url in let* r = Browser.post (Browser.create server) url params in check_response "other browser" ~status:200 ~body:too_old r; let+ r = Browser.post b url params in check_response "own browser" ~status:200 ~body:"na csrf post y" r) ; case "of a client process" (fun b -> let tab = Eliom_test_client.Tab.create b in let* r = Eliom_test_client.Tab.get tab "/link?to=csrf_tab" in let url = r.body in let* r = Eliom_test_client.Tab.get (Eliom_test_client.Tab.create b) url in check_response "other tab" ~status:200 ~body:too_old r; let+ r = Eliom_test_client.Tab.get tab url in check_response "own tab" ~status:200 ~body:"csrf of the tab" r) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-coservices" [attached server; non_attached server; limits server; csrf_safe server]) eliom-13.0.0/test/server/forms/000077500000000000000000000000001527170563500163265ustar00rootroot00000000000000eliom-13.0.0/test/server/forms/dune000066400000000000000000000004671527170563500172130ustar00rootroot00000000000000; Forms generated by Eliom, submitted as a browser does (executable (name server) (modules server) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server uri alcotest)) eliom-13.0.0/test/server/forms/server.ml000066400000000000000000000104141527170563500201660ustar00rootroot00000000000000(* The test server of test.ml: pages with forms generated by Eliom, and the services they submit to, which answer with their parameters. *) open Eliom open Eliom_test_services module P = Parameter module F = Content.Html.F module Form = F.Form (* [page path content] registers the page [path], whose body is [content ()] *) let page path content = Registration.Html.register ~service:(get [path] P.unit) (fun () () -> Lwt.return F.(html (head (title (txt path)) []) (body (content ())))) let opt = Option.value ~default:"none" (* Fields of text, a checkbox, and an optional parameter left empty *) let simple = get ["simple"] P.(int "i" ** string "s" ** opt (string "o") ** bool "b") let () = string simple (fun (i, (s, (o, b))) () -> text (Printf.sprintf "i=%d s=%s o=%s b=%b" i s (opt o) b)) let () = page "simple_form" (fun () -> [ Form.get_form ~service:simple (fun (i, (s, (o, b))) -> [ Form.input ~input_type:`Text ~name:i ~value:3 Form.int ; Form.input ~input_type:`Text ~name:s ~value:"a b&c" Form.string ; Form.input ~input_type:`Text ~name:o Form.string ; Form.bool_checkbox_one ~checked:true ~name:b () ]) ]) (* A text area, a select, radio buttons and a set of checkboxes, in a POST form *) let choices = Service.create ~path:(Service.Path ["choices"]) ~meth: (Service.Post ( P.unit , P.(string "t" ** string "sel" ** radio string "r" ** set string "c") )) () let () = string choices (fun () (t, (sel, (r, c))) -> text (Printf.sprintf "t=%s sel=%s r=%s c=%s" t sel (opt r) (String.concat "," (List.sort compare c)))) let () = page "choices_form" (fun () -> [ Form.post_form ~service:choices (fun (t, (sel, (r, c))) -> [ Form.textarea ~name:t ~value:"one\ntwo <&>" () ; Form.select ~name:sel Form.string (Form.Option ([], "a", None, false)) [Form.Option ([], "b", None, true)] ; Form.radio ~name:r ~value:"x" Form.string ; Form.radio ~checked:true ~name:r ~value:"y" Form.string ; Form.checkbox ~checked:true ~name:c ~value:"p" Form.string ; Form.checkbox ~checked:true ~name:c ~value:"q" Form.string ; Form.checkbox ~name:c ~value:"s" Form.string ]) () ]) (* A list *) let list = get ["list"] P.(list "l" (string "x")) let () = string list (fun l () -> text (String.concat "," l)) let () = page "list_form" (fun () -> [ Form.get_form ~service:list (fun names -> names.P.it (fun name v fields -> Form.input ~input_type:`Text ~name ~value:v Form.string :: fields) ["u"; "v"; "w"] []) ]) (* Coservices *) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let attached = Service.create_attached_post ~fallback ~post_params:P.(string "v") () let () = string attached (fun () v -> text ("attached " ^ v)) let na_get = Service.create ~path:Service.No_path ~meth:(Service.Get P.(string "v")) () let () = string na_get (fun v () -> text ("non-attached GET " ^ v)) let na_post = Service.create ~path:Service.No_path ~meth:(Service.Post (P.unit, P.(string "v"))) () let () = string na_post (fun () v -> text ("non-attached POST " ^ v)) let csrf = Service.create_attached_post ~csrf_safe:true ~fallback ~post_params:P.(string "v") () let () = string csrf (fun () v -> text ("CSRF-safe " ^ v)) let field name = [Form.input ~input_type:`Text ~name ~value:"z" Form.string] let () = page "coservice_forms" (fun () -> [ Form.post_form ~service:attached field () ; Form.get_form ~service:na_get field ; Form.post_form ~service:na_post field () ; Form.post_form ~service:csrf field () ]) (* A form whose action has a fragment *) let () = page "fragment_form" (fun () -> [ Form.get_form ~service:simple ~fragment:"f r" (fun (i, _) -> [Form.input ~input_type:`Text ~name:i ~value:3 Form.int]) ]) (* A suffix *) let suffix = get ["suffix"] P.(suffix (string "s")) let () = string suffix (fun s () -> text ("suffix " ^ s)) let () = page "suffix_form" (fun () -> [ Form.get_form ~service:suffix (fun s -> [Form.input ~input_type:`Text ~name:s ~value:"a" Form.string]) ]) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/forms/test.ml000066400000000000000000000066411527170563500176460ustar00rootroot00000000000000(* Tests of the forms generated by Eliom: submitted as a browser does, they send the parameters of their service. *) open Eliom_test_server open Helpers open Lwt.Syntax (* The forms of the page [url] *) let forms b url = let+ r = Browser.get b url in check_response url ~status:200 r; Html_form.forms ~url r.body let form b url = let+ forms = forms b url in match forms with | [form] -> form | _ -> Alcotest.failf "%s: %d forms" url (List.length forms) let submitted msg expected b form = let+ r = Html_form.submit b form in check_response msg ~status:200 ~body:expected r let fields server = let case = case server in ( "fields" , [ case "text and checkbox" (fun b -> (* An empty field of an optional parameter is the empty string. *) let* form = form b "/simple_form" in submitted "submitted" "i=3 s=a b&c o= b=true" b form) ; case "changed values" (fun b -> let* form = form b "/simple_form" in let form = Html_form.(form |> set "s" "é?=/" |> set "o" "given") in submitted "submitted" "i=3 s=é?=/ o=given b=true" b form) ; case "wrong type" (fun b -> let* form = form b "/simple_form" in let form = Html_form.set (List.hd (List.map fst form.Html_form.fields)) "x" form in let+ r = Html_form.submit b form in check_response "rejected" ~status:400 r) ; case "text area, select, radio buttons and checkboxes" (fun b -> let* form = form b "/choices_form" in Alcotest.(check bool) "POST" true (form.Html_form.meth = `POST); submitted "submitted" "t=one\ntwo <&> sel=b r=y c=p,q" b form) ; case "list" (fun b -> let* form = form b "/list_form" in submitted "submitted" "u,v,w" b form) ; case "fragment" (fun b -> (* In a fragment, + is not a space *) let+ r = Browser.get b "/fragment_form" in Alcotest.(check bool) "fragment of the action" true (contains r.body "#f%20r\"")) ] ) let coservices server = let case = case server in let nth b i = let+ forms = forms b "/coservice_forms" in List.nth forms i in ( "coservices" , [ case "attached" (fun b -> let* form = nth b 0 in submitted "submitted" "attached z" b form) ; case "non-attached, GET" (fun b -> let* form = nth b 1 in submitted "submitted" "non-attached GET z" b form) ; case "non-attached, POST" (fun b -> let* form = nth b 2 in submitted "submitted" "non-attached POST z" b form) ; case "CSRF-safe" (fun b -> let* form = nth b 3 in let* () = submitted "other browser" "fallback" (Browser.create server) form in submitted "own browser" "CSRF-safe z" b form) ; case "suffix" (fun b -> (* The form sends the suffix as a parameter: the server redirects to the URL with the suffix. *) let* form = form b "/suffix_form" in let* r = Html_form.submit b form in check_response "redirection" ~status:307 r; match Browser.header r "location" with | Some location -> let+ r = Browser.get b (Uri.path (Uri.of_string location)) in check_response "page" ~status:200 ~body:"suffix a" r | None -> Alcotest.fail "no location") ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-forms" [fields server; coservices server]) eliom-13.0.0/test/server/gc/000077500000000000000000000000001527170563500155715ustar00rootroot00000000000000eliom-13.0.0/test/server/gc/dune000066400000000000000000000004671527170563500164560ustar00rootroot00000000000000(executable (name server) (modules server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server lwt.unix alcotest)) eliom-13.0.0/test/server/gc/server.ml000066400000000000000000000155141527170563500174370ustar00rootroot00000000000000(* The test server of test.ml: states expire after 1 s, and are collected only when /collect is called, which runs each collector once. *) open Eliom open Eliom_test_services open Lwt.Syntax module P = Parameter module V = Reference.Volatile let () = State.set_default_global_volatile_data_state_timeout ~cookie_level:`Session ~override_configfile:true (Some 1.); State.set_default_global_service_state_timeout ~cookie_level:`Session ~override_configfile:true (Some 1.); State.set_default_global_persistent_data_state_timeout ~cookie_level:`Session ~override_configfile:true (Some 1.); Config.set_session_gc_frequency None; Config.set_persistent_session_gc_frequency None let session_scope = Common.default_session_scope let value = V.eref ~scope:session_scope "" let persistent_value = Reference.eref ~scope:session_scope ~persistent:("test_gc_value", [%json: string]) "" let () = string (get ["set"] P.(string "v")) (fun v () -> V.set value v; text "set") let () = string (get ["get"] P.unit) (fun () () -> text (V.get value)) let () = string (get ["persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set persistent_value v in text "set") (* Sets the timeout of all the persistent cookies, or unsets it without [t]. The cookies are read first: writing a cookie during an iteration on the SQLite table gives it to the iteration again. *) let () = string (get ["persistent"; "timeout"] P.(opt (float "t"))) (fun t () -> let* cookies = State.Ext.fold_persistent_data_cookies (fun cookie l -> Lwt.return (cookie :: l)) [] in let* () = Lwt_list.iter_s (fun cookie -> match t with | Some t -> State.Ext.set_persistent_data_cookie_timeout ~cookie (Some t) | None -> State.Ext.unset_persistent_data_cookie_timeout ~cookie) cookies in text "timeout") (* Sets the global timeout of persistent sessions, and computes again the expiration dates of the cookies. *) let () = string (get ["persistent"; "global"] P.(float "t")) (fun t () -> State.set_global_persistent_data_state_timeout ~cookie_scope:session_scope ~recompute_expdates:true (Some t); text "global") (* Whether the expiration dates of the persistent cookies are all more than 50 s away ("far"), not all ("near"), or there is no cookie ("none"). *) let () = string (get ["persistent"; "expiry"] P.unit) (fun () () -> let now = Unix.gettimeofday () in let* expiries = Mod_cookies.Persistent_cookies.Cookies.fold (fun _ {Mod_cookies.expiry; _} l -> Lwt.return (expiry :: l)) [] in let far = function Some t -> t > now +. 50. | None -> true in text (match expiries with | [] -> "none" | l -> if List.for_all far l then "far" else "near")) (* Sets the timeout of the cookie of the session after closing it. *) let () = string (get ["persistent"; "close"; "timeout"] P.unit) (fun () () -> let* state = State.Ext.current_persistent_data_state ~scope:session_scope () in let* cookie = State.Ext.get_persistent_cookie_info state in let* () = State.discard ~scope:session_scope () in let* () = State.Ext.set_persistent_data_cookie_timeout ~cookie (Some 100.) in text "closed") (* Gives a timeout to the first persistent cookie while the expiration dates are computed again for a global timeout of 100 s, after they have all been read, then says whether the timeout is "kept". The cookies are updated in the reverse order of the table: the update has begun when the last one has a new date, and the first one is updated last. The dates are then set back for a global timeout of 1 s. *) let () = string (get ["persistent"; "race"] P.unit) (fun () () -> let sitedata = Request_info.find_sitedata "race" in let* cookies = Mod_cookies.Persistent_cookies.Cookies.fold (fun k c l -> Lwt.return ((k, c) :: l)) [] in match cookies, List.rev cookies with | (last, _) :: _, (first, {Mod_cookies.full_state_name; _}) :: _ -> let update o n = Mod_sessadmin.update_pers_exp full_state_name sitedata (Some o) (Some n) in let rec wait_for_update n = let* {Mod_cookies.expiry; _} = Mod_cookies.Persistent_cookies.Cookies.find last in match expiry with | Some t when t > Unix.gettimeofday () +. 50. -> Lwt.return_unit | _ when n = 0 -> Lwt.fail_with "update not started" | _ -> let* () = Lwt.pause () in wait_for_update (n - 1) in let updated = update 1. 100. in let* () = wait_for_update 1000 in let* () = Mod_cookies.Persistent_cookies.set_timeout first (Common.TSome 1000.) in let* () = updated in let* {Mod_cookies.timeout; _} = Mod_cookies.Persistent_cookies.Cookies.find first in let* () = update 100. 1. in text (if timeout = Common.TSome 1000. then "kept" else "lost") | _ -> text "no cookie") let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let () = string (get ["coservice"] P.unit) (fun () () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in Registration.String.register ~scope:session_scope ~service (fun () () -> text "coservice"); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) let group_value = V.eref ~scope:Common.default_group_scope "" let () = string (get ["group"; "join"] P.(string "name" ** string "v")) (fun (name, v) () -> State.set_volatile_data_session_group ~scope:session_scope name; V.set group_value v; text "joined") let () = string (get ["collect"] P.unit) (fun () () -> let sitedata = Request_info.get_sitedata () in let* () = Mod_gc.collect_service_sessions sitedata in let* () = Mod_gc.collect_data_sessions sitedata in let* () = Mod_gc.collect_persistent_sessions sitedata in text "collected") (* The numbers of sessions, and the session groups *) let () = string (get ["count"] P.unit) (fun () () -> let* persistent = State.number_of_persistent_data_cookies () in text (Printf.sprintf "data=%d services=%d persistent=%d groups=[%s]" (State.number_of_volatile_data_cookies ()) (State.number_of_service_cookies ()) persistent (String.concat "," (List.sort compare (State.Ext.get_session_group_list ()))))) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/gc/test.ml000066400000000000000000000172301527170563500171050ustar00rootroot00000000000000(* Tests of the collectors of expired states, run on demand: states expire after 1 s of inactivity, and /collect runs each collector once. Each test ends with all the states of the server collected. *) open Eliom_test_server open Helpers open Lwt.Syntax let sleep = Lwt_unix.sleep (* [wait_for msg ok b url] waits until the answer of [url] satisfies [ok], for at most 10 s: the expiration dates are computed again in the background. *) let wait_for msg ok b url = let rec loop n = let* body = text b url in if ok body then Lwt.return_unit else if n = 0 then Alcotest.failf "%s: %s" msg body else let* () = sleep 0.1 in loop (n - 1) in loop 100 (* [case server name f] is a test that runs [f browser admin], where [browser ()] is a new browser and [admin], which opens no session, counts and collects the states. *) let case server name f = Alcotest.test_case name `Quick (fun () -> Lwt_main.run (let admin = Browser.create server in let* () = check "no session at the beginning" "data=0 services=0 persistent=0 groups=[]" admin "/count" in f (fun () -> Browser.create server) admin)) let collect admin = Lwt.map ignore (text admin "/collect") let collection server = let case = case server in ( "collection" , [ case "not expired" (fun browser admin -> let a = browser () in let* _ = text a "/set?v=a" in let* () = collect admin in let* () = check "kept" "data=1 services=0 persistent=0 groups=[]" admin "/count" in let* () = check "value" "a" a "/get" in let* () = sleep 1.5 in collect admin) ; case "volatile data sessions" (fun browser admin -> let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* () = check "open" "data=2 services=0 persistent=0 groups=[]" admin "/count" in let* () = sleep 1.5 in let* () = check "not collected yet" "data=2 services=0 persistent=0 groups=[]" admin "/count" in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "sessions in use" (fun browser admin -> let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in (* a is accessed within its timeout, while b is left for 2.4 s *) let rec use n = if n = 0 then Lwt.return_unit else let* () = sleep 0.6 in let* () = check "access" "a" a "/get" in use (n - 1) in let* () = use 4 in let* () = collect admin in let* () = check "only the expired one" "data=1 services=0 persistent=0 groups=[]" admin "/count" in let* () = check "value kept" "a" a "/get" in let* () = sleep 1.5 in collect admin) ; case "service sessions" (fun browser admin -> let a = browser () in let* _ = text a "/coservice" in let* () = check "open" "data=0 services=1 persistent=0 groups=[]" admin "/count" in let* () = sleep 1.5 in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "persistent sessions" (fun browser admin -> let a = browser () in let* _ = text a "/persistent/set?v=a" in let* () = check "open" "data=0 services=0 persistent=1 groups=[]" admin "/count" in let* () = sleep 1.5 in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "persistent timeout unset" (fun browser admin -> (* The cookie expires with the global timeout, without being visited again. *) let a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = text admin "/persistent/timeout?t=100" in let* _ = text admin "/persistent/timeout" in let* () = sleep 1.5 in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "persistent timeout of a cookie" (fun browser admin -> let a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = text admin "/persistent/timeout?t=100" in let* _ = text a "/persistent/set?v=b" in let* () = sleep 1.5 in let* () = collect admin in let* () = check "kept" "data=0 services=0 persistent=1 groups=[]" admin "/count" in let* _ = text admin "/persistent/timeout" in let* _ = text a "/persistent/set?v=c" in let* () = sleep 1.5 in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "global persistent timeout" (fun browser admin -> (* Changing the global timeout computes the expiration dates of the cookies again, in the background. *) let a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = text admin "/persistent/global?t=100" in let* () = wait_for "computed again" (( = ) "far") admin "/persistent/expiry" in let* () = sleep 1.5 in let* () = collect admin in let* () = check "kept" "data=0 services=0 persistent=1 groups=[]" admin "/count" in let* _ = text admin "/persistent/global?t=1" in (* The cookie is closed, or has an expiration date in the past (the dates are compared to the time in whole seconds). *) let* () = wait_for "computed again" (( <> ) "far") admin "/persistent/expiry" in let* () = collect admin in check "closed" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "persistent timeout during an update" (fun browser admin -> (* A timeout given to a cookie while the expiration dates are computed again is kept. The other cookies give the update time to reach the first one. *) let* () = Lwt_list.iter_s (fun i -> Lwt.map ignore (text (browser ()) (Printf.sprintf "/persistent/set?v=%d" i))) (List.init 10 Fun.id) in let* () = check "kept" "kept" admin "/persistent/race" in let* () = sleep 1.5 in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "persistent timeout of a closed session" (fun browser admin -> (* Setting the timeout does not open the session again. *) let a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = text a "/persistent/close/timeout" in check "closed" "data=0 services=0 persistent=0 groups=[]" admin "/count") ; case "session groups" (fun browser admin -> (* A group goes with the last of its sessions. *) let a = browser () and b = browser () in let* _ = text a "/group/join?name=gc-g&v=g" in let* _ = text b "/group/join?name=gc-g&v=g" in let* () = check "open" "data=2 services=0 persistent=0 groups=[gc-g]" admin "/count" in let* () = sleep 1.5 in let* () = collect admin in check "collected" "data=0 services=0 persistent=0 groups=[]" admin "/count") ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-gc" [collection server]) eliom-13.0.0/test/server/global_ref/000077500000000000000000000000001527170563500172745ustar00rootroot00000000000000eliom-13.0.0/test/server/global_ref/dune000066400000000000000000000005021527170563500201470ustar00rootroot00000000000000(executable (name server) (modules toplevel_ref server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite unix eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server alcotest)) eliom-13.0.0/test/server/global_ref/server.ml000066400000000000000000000013111527170563500211300ustar00rootroot00000000000000(* The test server of test.ml: services that set, read and unset a persistent reference of global scope created at the toplevel of the module [Toplevel_ref], and answer in plain text. *) open Eliom open Eliom_test_services module P = Parameter open Lwt.Syntax let () = string (get ["set"] P.(string "v")) (fun v () -> let* () = Reference.set Toplevel_ref.value v in text "set") let () = string (get ["get"] P.unit) (fun () () -> let* v = Reference.get Toplevel_ref.value in text v) let () = string (get ["unset"] P.unit) (fun () () -> let* () = Reference.unset Toplevel_ref.value in text "unset") let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/global_ref/test.ml000066400000000000000000000016421527170563500206100ustar00rootroot00000000000000(* Tests of a persistent reference of global scope created at the toplevel of a module of the server, before the location of the database is set. *) open Eliom_test_server open Helpers open Lwt.Syntax let case name f = Alcotest.test_case name `Quick (fun () -> Lwt_main.run (f ())) let tests server = ( "global persistent reference" , [ case "created at the toplevel" (fun () -> let a = Browser.create server and b = Browser.create server in let* () = check "default value" "" a "/get" in let* _ = text a "/set?v=a" in let* () = check "other browser" "a" b "/get" in Server_harness.restart server; let* () = check "kept after a restart" "a" a "/get" in let* _ = text a "/unset" in check "unset" "" b "/get") ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-global-ref" [tests server]) eliom-13.0.0/test/server/global_ref/toplevel_ref.ml000066400000000000000000000010151527170563500223110ustar00rootroot00000000000000(* A persistent reference of global scope created at the toplevel of a module, as a library does, before the server program sets the location of the database. *) let value = Eliom.Reference.eref ~scope:Eliom.Common.global_scope ~persistent:("test_global_ref", [%json: string]) "" (* Something slow at the toplevel of a module, here a sleep, lets the threads of the database run before the database file is set. The reference must not access the database before it is used. *) let () = Unix.sleepf 0.2 eliom-13.0.0/test/server/global_ref/toplevel_ref.mli000066400000000000000000000002031527170563500224600ustar00rootroot00000000000000val value : string Eliom.Reference.eref (** A persistent reference of global scope, created at the toplevel of this module. *) eliom-13.0.0/test/server/html_form/000077500000000000000000000000001527170563500171675ustar00rootroot00000000000000eliom-13.0.0/test/server/html_form/dune000066400000000000000000000001701527170563500200430ustar00rootroot00000000000000; Tests of Html_form, the forms of a page (test (name test) (package eliom) (libraries eliom_test_server alcotest)) eliom-13.0.0/test/server/html_form/test.ml000066400000000000000000000056211527170563500205040ustar00rootroot00000000000000(* Tests of Html_form, the forms of a page, on pages written by hand *) open Eliom_test_server let form = Alcotest.testable (fun fmt {Html_form.meth; action; fields} -> Format.fprintf fmt "%s %s [%s]" (match meth with `GET -> "GET" | `POST -> "POST") action (String.concat "; " (List.map (fun (n, v) -> n ^ "=" ^ v) fields))) ( = ) let check msg expected ~url page = Alcotest.(check (list form)) msg expected (Html_form.forms ~url page) let test_fields () = check "submitted fields" [ { Html_form.meth = `POST ; action = "/target" ; fields = [ "text", "a&b \"c\"" ; "hidden", "h" ; "checked", "on" ; "radio", "y" ; "area", "one\ntwo <&>" ; "select", "b" ; "first", "1" ; "multiple", "m1" ; "multiple", "m3" ] } ] ~url:"/page" {| |} let test_page () = check "forms of a page" [ {Html_form.meth = `GET; action = "/dir/target?x=1"; fields = ["a", "1"]} ; {Html_form.meth = `GET; action = "/dir/page?p=q"; fields = []} ] ~url:"/dir/page?p=q" {|
|} let test_set () = let f = { Html_form.meth = `GET ; action = "/target" ; fields = ["a", "1"; "b", "2"; "a", "3"] } in Alcotest.check form "replaced" {f with fields = ["a", "x"; "b", "2"]} (Html_form.set "a" "x" f); Alcotest.check form "added" {f with fields = f.fields @ ["c", "y"]} (Html_form.set "c" "y" f) let () = Alcotest.run "html-form" [ ( "forms" , [ Alcotest.test_case "fields" `Quick test_fields ; Alcotest.test_case "page" `Quick test_page ; Alcotest.test_case "set" `Quick test_set ] ) ] eliom-13.0.0/test/server/lib/000077500000000000000000000000001527170563500157465ustar00rootroot00000000000000eliom-13.0.0/test/server/lib/browser.ml000066400000000000000000000032741527170563500177710ustar00rootroot00000000000000open Lwt.Syntax type t = {ctx : Cohttp_lwt_unix.Net.ctx; mutable jar : Cookie_jar.t} type response = {status : int; headers : Cohttp.Header.t; body : string} let host = "eliom-test" let create server = let hosts = Hashtbl.create 1 in Hashtbl.add hosts host (`Unix_domain_socket (Server_harness.socket server)); { ctx = Cohttp_lwt_unix.Net.init ~resolver:(Resolver_lwt_unix.static hosts) () ; jar = Cookie_jar.empty } let path_of_url url = match String.index_opt url '?' with | Some i -> String.sub url 0 i | None -> url let call ?(headers = []) ?body meth b url = let path = path_of_url url in let cookie = Option.map (fun c -> "cookie", c) (Cookie_jar.header ~now:(Unix.time ()) ~path b.jar) in let headers = Cohttp.Header.of_list (Option.to_list cookie @ headers) in let uri = Uri.of_string ("http://" ^ host ^ url) in let* resp, body = Cohttp_lwt_unix.Client.call ~ctx:b.ctx ~headers ?body meth uri in let* body = Cohttp_lwt.Body.to_string body in let headers = Cohttp.Response.headers resp in b.jar <- Cookie_jar.store ~now:(Unix.time ()) ~path (Cohttp.Header.get_multi headers "set-cookie") b.jar; Lwt.return { status = Cohttp.Code.code_of_status (Cohttp.Response.status resp) ; headers ; body } let get ?headers b url = call ?headers `GET b url let post ?(headers = []) b url params = let body = Cohttp_lwt.Body.of_string (Uri.encoded_of_query (List.map (fun (n, v) -> n, [v]) params)) in call ~headers:(("content-type", "application/x-www-form-urlencoded") :: headers) ~body `POST b url let cookies b = Cookie_jar.cookies ~now:(Unix.time ()) b.jar let header r name = Cohttp.Header.get r.headers name eliom-13.0.0/test/server/lib/browser.mli000066400000000000000000000022751527170563500201420ustar00rootroot00000000000000(** Simulated browsers: HTTP clients of a test server, each with its own cookies. *) type t (** A browser. *) type response = {status : int; headers : Cohttp.Header.t; body : string} (** The responses of the server. *) val create : Server_harness.t -> t (** [create server] is a new browser for [server], with no cookie. *) val get : ?headers:(string * string) list -> t -> string -> response Lwt.t (** [get b url] sends a GET request for [url], a path with an optional query string, e.g. ["/a/b?x=1"]. The cookies of [b] matching the path are sent with [headers], and the cookies set by the response are kept, as described in {!Cookie_jar}. Redirections are not followed. *) val post : ?headers:(string * string) list -> t -> string -> (string * string) list -> response Lwt.t (** [post b url params] sends a POST request for [url], with [params] in the body, form-encoded. Cookies are handled as by {!get}. *) val cookies : t -> (string * string) list (** [cookies b] are the names and values of the cookies of [b] not expired, sorted by name. *) val header : response -> string -> string option (** [header r name] is the value of the header [name] of [r], if any. *) eliom-13.0.0/test/server/lib/cookie_jar.ml000066400000000000000000000107651527170563500204160ustar00rootroot00000000000000type cookie = { name : string ; value : string ; path : string ; expires : float option ; secure : bool } (* In the order of creation *) type t = cookie list let empty = [] (* Dates of cookies, as written by Ocsigen Server: "Thu, 01 Jan 1970 00:00:00 GMT". *) let months = [ "Jan" ; "Feb" ; "Mar" ; "Apr" ; "May" ; "Jun" ; "Jul" ; "Aug" ; "Sep" ; "Oct" ; "Nov" ; "Dec" ] (* [days_from_civil y m d] is the number of days from 1970-01-01 to [y-m-d] (proleptic Gregorian calendar, [m] from 1 to 12). *) let days_from_civil y m d = let y = if m <= 2 then y - 1 else y in let era = (if y >= 0 then y else y - 399) / 400 in let yoe = y - (era * 400) in let doy = (((153 * if m > 2 then m - 3 else m + 9) + 2) / 5) + d - 1 in let doe = (yoe * 365) + (yoe / 4) - (yoe / 100) + doy in (era * 146097) + doe - 719468 let month_index mon = let rec index i = function | [] -> None | m :: l -> if m = mon then Some i else index (i + 1) l in index 1 months let parse_date s = match Scanf.sscanf s " %_s %d %s %d %d:%d:%d GMT" (fun d mon y h mi sec -> Option.map (fun m -> float_of_int ((days_from_civil y m d * 86400) + (h * 3600) + (mi * 60) + sec)) (month_index mon)) with | date -> date | exception (Scanf.Scan_failure _ | Failure _ | End_of_file) -> None let split_at c s = Option.map (fun i -> ( String.trim (String.sub s 0 i) , String.trim (String.sub s (i + 1) (String.length s - i - 1)) )) (String.index_opt s c) let attribute a = match split_at '=' a with | Some (n, v) -> String.lowercase_ascii n, v | None -> String.lowercase_ascii (String.trim a), "" (* RFC 6265, 5.2.2: digits, with an optional minus sign *) let max_age s = match int_of_string_opt s with | Some n when String.for_all (fun c -> c = '-' || (c >= '0' && c <= '9')) s -> Some n | _ -> None (* RFC 6265, 5.1.4: the directory of the path of the request *) let default_path path = match String.rindex_opt path '/' with | Some i when i > 0 && path.[0] = '/' -> String.sub path 0 i | _ -> "/" (* RFC 6265, 5.2 and 5.3. The last occurrence of an attribute counts, and Max-Age takes precedence over Expires. *) let parse ~now ~path header = let name_value, attributes = match String.index_opt header ';' with | Some i -> ( String.sub header 0 i , List.rev_map attribute (String.split_on_char ';' (String.sub header (i + 1) (String.length header - i - 1))) ) | None -> header, [] in match split_at '=' name_value with | None | Some ("", _) -> None | Some (name, value) -> let attribute n = List.assoc_opt n attributes in let path = match attribute "path" with | Some p when String.starts_with ~prefix:"/" p -> p | _ -> default_path path in let expires = match Option.bind (attribute "max-age") max_age with | Some s -> Some (now +. float_of_int s) | None -> Option.bind (attribute "expires") parse_date in Some {name; value; path; expires; secure = List.mem_assoc "secure" attributes} let expired now c = match c.expires with Some e -> e <= now | None -> false let same c c' = c.name = c'.name && c.path = c'.path (* A cookie replacing another one keeps its place (RFC 6265, 5.3, 11.3), and an expired one removes it. *) let add now jar c = let added = if expired now c then [] else [c] in if List.exists (same c) jar then List.concat_map (fun c' -> if same c c' then added else [c']) jar else jar @ added let store ~now ~path set_cookies jar = List.fold_left (fun jar h -> match parse ~now ~path h with None -> jar | Some c -> add now jar c) jar set_cookies (* RFC 6265, 5.1.4 *) let path_matches ~cookie_path path = let n = String.length cookie_path in path = cookie_path || String.starts_with ~prefix:cookie_path path && (cookie_path.[n - 1] = '/' || path.[n] = '/') let header ~now ~path jar = match List.filter (fun c -> (not c.secure) && (not (expired now c)) && path_matches ~cookie_path:c.path path) jar with | [] -> None | l -> let l = List.stable_sort (fun c c' -> compare (String.length c'.path) (String.length c.path)) l in Some (String.concat "; " (List.map (fun c -> c.name ^ "=" ^ c.value) l)) let cookies ~now jar = List.sort compare (List.filter_map (fun c -> if expired now c then None else Some (c.name, c.value)) jar) eliom-13.0.0/test/server/lib/cookie_jar.mli000066400000000000000000000023621527170563500205610ustar00rootroot00000000000000(** Cookie jars of simulated browsers, kept as RFC 6265 says, for a single host reached without HTTPS. *) type t (** A set of cookies. *) val empty : t (** [empty] is the jar with no cookie. *) val store : now:float -> path:string -> string list -> t -> t (** [store ~now ~path set_cookies jar] is [jar] with the cookies of [set_cookies], the values of the [Set-Cookie] headers of the response to a request for [path], received at [now]. A cookie replaces the one of [jar] with the same name and path, and an expired cookie removes it. *) val header : now:float -> path:string -> t -> string option (** [header ~now ~path jar] is the value of the [Cookie] header of a request for [path] at [now], if a cookie of [jar] matches: its path matches [path], it has not expired and it is not secure. Cookies with longer paths come first. *) val cookies : now:float -> t -> (string * string) list (** [cookies ~now jar] are the names and values of the cookies of [jar] not expired at [now], sorted by name. *) val parse_date : string -> float option (** [parse_date s] is the time of the cookie date [s], in the format written by Ocsigen Server, e.g. ["Thu, 01 Jan 1970 00:00:00 GMT"], if [s] is a valid date in this format. *) eliom-13.0.0/test/server/lib/dune000066400000000000000000000005141527170563500166240ustar00rootroot00000000000000; Helpers of the tests: a test server, simulated browsers, checks of their ; requests with Alcotest. The unit tests use its checks too. (library (name eliom_test_server) (libraries unix lwt lwt.unix ocsigenserver cohttp cohttp-lwt cohttp-lwt-unix conduit-lwt-unix ocsipersist-sqlite.settings uri alcotest)) eliom-13.0.0/test/server/lib/helpers.ml000066400000000000000000000016201527170563500177410ustar00rootroot00000000000000open Lwt.Syntax let contains s sub = let n = String.length sub in let rec loop i = i + n <= String.length s && (String.sub s i n = sub || loop (i + 1)) in loop 0 let check_response ?status ?body msg (r : Browser.response) = Option.iter (fun s -> Alcotest.(check int) (msg ^ ": status") s r.status) status; Option.iter (fun b -> Alcotest.(check string) (msg ^ ": body") b r.body) body let text b url = let+ r = Browser.get b url in if r.status <> 200 then Alcotest.failf "%s: status %d" url r.status; r.body let check msg expected b url = let+ body = text b url in Alcotest.(check string) msg expected body let case ?(speed = `Quick) server name f = Alcotest.test_case name speed (fun () -> Lwt_main.run (f (Browser.create server))) let case_browsers server name f = Alcotest.test_case name `Quick (fun () -> Lwt_main.run (f (fun () -> Browser.create server))) eliom-13.0.0/test/server/lib/helpers.mli000066400000000000000000000022031527170563500201100ustar00rootroot00000000000000(** Helpers of the tests: requests checked with Alcotest, test cases. *) val contains : string -> string -> bool (** [contains s sub] tells whether [sub] occurs in [s]. *) val check_response : ?status:int -> ?body:string -> string -> Browser.response -> unit (** [check_response ?status ?body msg r] checks the status and the body of [r], when given. *) val text : Browser.t -> string -> string Lwt.t (** [text b url] is the body of the response to [url] for [b], checked to be a success. *) val check : string -> string -> Browser.t -> string -> unit Lwt.t (** [check msg expected b url] checks that [text b url] is [expected]. *) val case : ?speed:Alcotest.speed_level -> Server_harness.t -> string -> (Browser.t -> unit Lwt.t) -> unit Alcotest.test_case (** [case ?speed server name f] is a test that runs [f b] with a new browser [b], of speed [speed] ([`Quick] by default). *) val case_browsers : Server_harness.t -> string -> ((unit -> Browser.t) -> unit Lwt.t) -> unit Alcotest.test_case (** [case_browsers server name f] is a test that runs [f browser], where [browser ()] is a new browser. *) eliom-13.0.0/test/server/lib/html_form.ml000066400000000000000000000204721527170563500202740ustar00rootroot00000000000000type t = {meth : [`GET | `POST]; action : string; fields : (string * string) list} (* [find s sub i] is the position of the first [sub] in [s] from [i] *) let find s sub i = let n = String.length s and m = String.length sub in let rec loop j = if j + m > n then None else if String.sub s j m = sub then Some j else loop (j + 1) in loop i (* [after s sub i] is the position after the first [sub] in [s] from [i], or the end of [s] *) let after s sub i = match find s sub i with | Some j -> j + String.length sub | None -> String.length s let starts s i prefix = i + String.length prefix <= String.length s && String.sub s i (String.length prefix) = prefix (* The entities of an attribute value or a text *) let decode_entities s = let b = Buffer.create (String.length s) in let character entity = match entity with | "amp" -> Some (Uchar.of_char '&') | "lt" -> Some (Uchar.of_char '<') | "gt" -> Some (Uchar.of_char '>') | "quot" -> Some (Uchar.of_char '"') | "apos" -> Some (Uchar.of_char '\'') | e when String.length e > 1 && e.[0] = '#' -> let code = if e.[1] = 'x' || e.[1] = 'X' then int_of_string_opt ("0x" ^ String.sub e 2 (String.length e - 2)) else int_of_string_opt (String.sub e 1 (String.length e - 1)) in Option.bind code (fun c -> if Uchar.is_valid c then Some (Uchar.of_int c) else None) | _ -> None in let rec loop i = if i < String.length s then match s.[i], String.index_from_opt s i ';' with | '&', Some j -> ( match character (String.sub s (i + 1) (j - i - 1)) with | Some u -> Buffer.add_utf_8_uchar b u; loop (j + 1) | None -> Buffer.add_char b '&'; loop (i + 1)) | c, _ -> Buffer.add_char b c; loop (i + 1) in loop 0; Buffer.contents b type tag = {name : string; closing : bool; attrs : (string * string) list} let is_space = function ' ' | '\n' | '\t' | '\r' -> true | _ -> false let is_name_char = function | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' | ':' -> true | _ -> false (* [tag s i] is the tag of [s] at [i], where [s.[i]] is ['<'], and the position after it *) let tag s i = let n = String.length s in let rec skip p j = if j < n && p s.[j] then skip p (j + 1) else j in let closing = i + 1 < n && s.[i + 1] = '/' in let start = if closing then i + 2 else i + 1 in let stop = skip is_name_char start in let rec attrs j acc = let j = skip is_space j in if j >= n then List.rev acc, n else match s.[j] with | '>' -> List.rev acc, j + 1 | '/' -> attrs (j + 1) acc | _ -> let k = skip is_name_char j in if k = j then attrs (j + 1) acc else let name = String.lowercase_ascii (String.sub s j (k - j)) in let k = skip is_space k in if k < n && s.[k] = '=' then let v = skip is_space (k + 1) in let value, next = if v < n && (s.[v] = '"' || s.[v] = '\'') then let e = match String.index_from_opt s (v + 1) s.[v] with | Some e -> e | None -> failwith "Html_form: unterminated attribute" in String.sub s (v + 1) (e - v - 1), e + 1 else let e = skip (fun c -> not (is_space c || c = '>')) v in String.sub s v (e - v), e in attrs next ((name, decode_entities value) :: acc) else attrs k ((name, name) :: acc) in let attrs, next = attrs stop [] in ( { name = String.lowercase_ascii (String.sub s start (stop - start)) ; closing ; attrs } , next ) let attr name t = List.assoc_opt name t.attrs let has name t = List.mem_assoc name t.attrs (* The values of a select, from its options (value and selection) *) let selected ~multiple options = match List.filter_map (fun (v, s) -> if s then Some v else None) options with | [] when multiple -> [] | [] -> ( match options with (v, _) :: _ -> [v] | [] -> []) | l when multiple -> l | l -> [List.nth l (List.length l - 1)] (* The fields of an input *) let input t fields = match attr "name" t with | None -> fields | Some name -> ( match Option.map String.lowercase_ascii (attr "type" t) with | Some ("checkbox" | "radio") -> if has "checked" t then (name, Option.value ~default:"on" (attr "value" t)) :: fields else fields | Some ("submit" | "button" | "image" | "reset" | "file") -> fields | _ -> (name, Option.value ~default:"" (attr "value" t)) :: fields) let forms ~url page = let base = Uri.of_string ("http://host" ^ url) in let resolve action = Uri.path_and_query (Uri.resolve "http" base (Uri.of_string action)) in (* [form] is the form being read, with its fields in reverse order, and [select] the select being read, with its options in reverse order *) let rec loop i form select forms = match String.index_from_opt page i '<' with | None -> List.rev forms | Some i when starts page i "" i) form select forms | Some i when starts page i " loop (after page ">" i) form select forms | Some i -> ( let t, next = tag page i in let text_until close = let stop = Option.value ~default:(String.length page) (find page close next) in decode_entities (String.sub page next (stop - next)), stop in match t.name, t.closing, form with | ("script" | "style"), false, _ -> loop (after page (" let meth = match Option.map String.lowercase_ascii (attr "method" t) with | Some "post" -> `POST | _ -> `GET in let action = resolve (Option.value ~default:url (attr "action" t)) in loop next (Some (meth, action, [])) None forms | "form", true, Some (meth, action, fields) -> loop next None None ({meth; action; fields = List.rev fields} :: forms) | _, _, None -> loop next form select forms | "input", false, Some (meth, action, fields) -> loop next (Some (meth, action, input t fields)) select forms | "textarea", false, Some (meth, action, fields) -> let text, stop = text_until " (name, text) :: fields | None -> fields in loop stop (Some (meth, action, fields)) select forms | "select", false, _ -> loop next form (Some (attr "name" t, has "multiple" t, [])) forms | "option", false, _ -> ( match select with | Some (name, multiple, options) -> let text, stop = text_until " loop next form select forms) | "select", true, Some (meth, action, fields) -> let fields = match select with | Some (Some name, multiple, options) -> List.fold_left (fun fields v -> (name, v) :: fields) fields (selected ~multiple (List.rev options)) | _ -> fields in loop next (Some (meth, action, fields)) None forms | _ -> loop next form select forms) in loop 0 None None [] let set name value form = let rec replace = function | [] -> [name, value] | (n, _) :: rest when n = name -> (name, value) :: List.filter (fun (n, _) -> n <> name) rest | field :: rest -> field :: replace rest in {form with fields = replace form.fields} let submit b {meth; action; fields} = match meth with | `GET -> Browser.get b (Uri.path_and_query (Uri.with_query' (Uri.of_string action) fields)) | `POST -> Browser.post b action fields eliom-13.0.0/test/server/lib/html_form.mli000066400000000000000000000021351527170563500204410ustar00rootroot00000000000000(** The forms of a page, submitted as a browser does. The page must be XHTML, as Eliom prints it. *) type t = { meth : [`GET | `POST] ; action : string (** The path and query of the URL of the form *) ; fields : (string * string) list (** The name and value of each field, in the order of the page *) } (** A form, with the values that a browser submits when nothing is changed: text and hidden inputs, checked checkboxes and radio buttons, selected options (the first one of a select without selected option) and text areas. Buttons are not submitted. *) val forms : url:string -> string -> t list (** [forms ~url page] are the forms of [page], the page at [url] (a path and query), whose actions are resolved against [url]. *) val set : string -> string -> t -> t (** [set name value form] is [form] where the fields named [name] are replaced by one field of value [value]. *) val submit : Browser.t -> t -> Browser.response Lwt.t (** [submit b form] sends [form] from [b]: a GET form replaces the query of its action by its fields, a POST form sends them url-encoded. *) eliom-13.0.0/test/server/lib/server_harness.ml000066400000000000000000000125511527170563500213350ustar00rootroot00000000000000type t = {exe : string; dir : string; mutable pid : int} let socket_name = "local.sock" let command_pipe = "local.cmd" let log_name = "server.log" let socket {dir; _} = Filename.concat dir socket_name let rec remove path = match Sys.is_directory path with | true -> Array.iter (fun f -> remove (Filename.concat path f)) (Sys.readdir path); Sys.rmdir path | false -> Sys.remove path | exception Sys_error _ -> () (* The path of a Unix-domain socket is limited to about 100 bytes, less than the usual temporary directory of macOS. *) let temp_base = let base = Filename.get_temp_dir_name () in if String.length base > 50 && Sys.file_exists "/tmp" then "/tmp" else base let rec temp_dir n = let dir = Filename.concat temp_base (Printf.sprintf "eliom-test-%d-%d" (Unix.getpid ()) n) in match Sys.mkdir dir 0o700 with | () -> dir | exception Sys_error _ when n < 1000 -> temp_dir (n + 1) let read_file file = match In_channel.with_open_bin file In_channel.input_all with | s -> s | exception Sys_error e -> e let print_log dir = Printf.eprintf "Server log (%s):\n%s\n%!" dir (read_file (Filename.concat dir log_name)) let exited pid = match Unix.waitpid [Unix.WNOHANG] pid with | 0, _ -> false | _ -> true | exception Unix.Unix_error (Unix.ECHILD, _, _) -> true (* [wait_for p] waits until [p ()] holds, for 20 s at most. *) let wait_for p = let rec loop n = if p () then true else if n = 0 then false else ( Unix.sleepf 0.01; loop (n - 1)) in loop 2000 let kill pid = Unix.kill pid Sys.sigkill; ignore (Unix.waitpid [] pid) let stop pid dir = if not (exited pid) then (* With O_NONBLOCK, opening the pipe fails rather than blocks if the server does not read it. *) match let fd = Unix.openfile (Filename.concat dir command_pipe) [Unix.O_WRONLY; Unix.O_NONBLOCK] 0 in Fun.protect ~finally:(fun () -> Unix.close fd) (fun () -> ignore (Unix.write_substring fd "shutdown\n" 0 9)) with | () -> if not (wait_for (fun () -> exited pid)) then ( prerr_endline "The test server did not stop: killing it."; kill pid) | exception Unix.Unix_error (e, _, _) -> Printf.eprintf "Cannot send the shutdown command to the test server (%s): killing it.\n%!" (Unix.error_message e); kill pid (* The server is ready when it accepts connections. Its socket file exists a little earlier, as soon as the socket is bound; the command pipe is opened before. *) let accepts_connections server = let fd = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in Fun.protect ~finally:(fun () -> Unix.close fd) (fun () -> match Unix.connect fd (Unix.ADDR_UNIX (socket server)) with | () -> true | exception Unix.Unix_error ((Unix.ENOENT | Unix.ECONNREFUSED), _, _) -> false) (* [launch exe dir] starts [exe] in [dir] and returns its pid, once it accepts connections. Its outputs are appended to the log. *) let launch exe dir = let log = Unix.openfile (Filename.concat dir log_name) [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND] 0o600 in let pid = Unix.create_process exe [|exe; dir|] Unix.stdin log log in Unix.close log; let server = {exe; dir; pid} in if not (wait_for (fun () -> accepts_connections server || exited pid) && not (exited pid)) then ( print_log dir; stop pid dir; failwith ("the test server " ^ exe ^ " did not start")); pid let with_server exe f = let dir = temp_dir 0 in let server = {exe; dir; pid = launch exe dir} in match f server with | r -> stop server.pid dir; remove dir; r | exception e -> let bt = Printexc.get_raw_backtrace () in stop server.pid dir; print_log dir; Printexc.raise_with_backtrace e bt let restart server = stop server.pid server.dir; (* The files of the previous run that the server creates again *) List.iter (fun f -> remove (Filename.concat server.dir f)) [socket_name; command_pipe]; server.pid <- launch server.exe server.dir let start instructions = let dir = Sys.argv.(1) in Sys.chdir dir; if not (Sys.file_exists "log") then Sys.mkdir "log" 0o700; (* An absolute path. With ocsipersist-sqlite 3.1, a database opened before this point, from the toplevel of a module, is the default file "ocsidb" of the start directory. As the name differs, later accesses use this file instead, and the tests notice that the data are not there. *) Ocsipersist_settings.set_db_file (Filename.concat (Sys.getcwd ()) "ocsidb"); (* No default charset, which the test "no default charset" of services/test.ml relies on. Given to the host, as Ocsigen Server may give one by default, and as [~default_charset] of [start] only reaches the hosts since Ocsigen Server 8.1. *) (* A Unix-domain socket has no port: requests get the port given here, which absolute URLs show. With port 0, Ocsigen Server 8.0.0 writes port 0 there, and later versions the default port. The client tests give the same port to their page (test/client/stub.js). *) Ocsigen.Server.start ~ports:[`Unix socket_name, 8080] ~command_pipe ~logdir:"log" ~debugmode:true [ Ocsigen.Server.host ~charset_assoc:(Ocsigen_http.Charset_mime.empty_charset_assoc ()) instructions ] eliom-13.0.0/test/server/lib/server_harness.mli000066400000000000000000000026031527170563500215030ustar00rootroot00000000000000(** Test servers run in a child process, in a directory of their own. *) type t (** A running test server. *) val with_server : string -> (t -> 'a) -> 'a (** [with_server exe f] runs the server program [exe] and returns [f s], where [s] is the running server, then stops the server. [exe] is started in a new temporary directory, given as its only argument, and must start Ocsigen Server with {!start}. The standard and error outputs of the server go to a log, printed if [f] raises an exception, which is raised again. The directory is removed if [f] returns. @raise Failure if the server does not start. *) val restart : t -> unit (** [restart s] stops [s] and starts its program again, in the same directory: the files of the server, such as persistent data, are kept. The browsers of [s] can still be used. *) val socket : t -> string (** [socket s] is the Unix-domain socket on which [s] listens. *) val start : Ocsigen.Server.instruction list -> unit (** [start instructions] starts Ocsigen Server in the directory given as argument of the program, listening on the socket and the command pipe that {!with_server} expects, with a single host running [instructions]. The persistent data go to the SQLite database [ocsidb] of that directory: the server program links [ocsipersist-sqlite]. It does not return. To be called by the server program. *) eliom-13.0.0/test/server/menus/000077500000000000000000000000001527170563500163275ustar00rootroot00000000000000eliom-13.0.0/test/server/menus/dune000066400000000000000000000003361527170563500172070ustar00rootroot00000000000000(executable (name server) (modules server) (libraries eliom.server ocsipersist-sqlite eliom_test_server)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server alcotest)) eliom-13.0.0/test/server/menus/server.ml000066400000000000000000000031501527170563500201660ustar00rootroot00000000000000(* The test server of test.ml: pages answering with their menus, printed, one per line. *) open Eliom module H = Content.Html let page path = Service.create ~path:(Service.Path path) ~meth:(Service.Get Parameter.unit) () let home = page [] let a = page ["a"] let b = page ["b"] let c = page ["c"] let section = page ["section"; ""] let x = page ["section"; "x"] let y = page ["section"; "y"] let print elt = Format.asprintf "%a" (H.Printer.pp_elt ()) elt let menu = [a, [H.F.txt "A"]; b, [H.F.txt "B"]; c, [H.F.txt "C"]] let leaf text service = [H.F.txt text], Tools.Site_tree (Tools.Main_page (Tools.Srv service), []) let site = ( Tools.Main_page (Tools.Srv home) , [ leaf "A" a ; ( [H.F.txt "Section"] , Tools.Site_tree (Tools.Main_page (Tools.Srv section), [leaf "X" x; leaf "Y" y]) ) ; [H.F.txt "Off"], Tools.Disabled ] ) let menus () = String.concat "\n" [ print (Tools.F.menu menu ()) ; print (Tools.F.menu menu ~service:b ()) ; String.concat "" (List.map print (Tools.F.hierarchical_menu_depth_first site ())) ; String.concat "" (List.map print (Tools.F.hierarchical_menu_depth_first ~whole_tree:true site ())) ; String.concat "" (List.map print (Tools.F.hierarchical_menu_breadth_first site ())) ; String.concat "" (List.map print (Tools.F.structure_links site ())) ] let () = List.iter (fun service -> Registration.String.register ~service (fun () () -> Lwt.return (menus (), "text/plain"))) [home; a; b; c; section; x; y] let () = Eliom_test_server.Server_harness.start [App.run ~xhr_links:false ()] eliom-13.0.0/test/server/menus/test.ml000066400000000000000000000113721527170563500176440ustar00rootroot00000000000000(* Tests of the menus of Eliom.Tools, printed by the pages of the server: the current page of a menu is found from the URL of the request. *) open Eliom_test_server open Helpers open Lwt.Syntax (* The menus of a page, in the order of server.ml *) type menus = { menu : string ; menu_of_b : string ; depth_first : string ; whole_tree : string ; breadth_first : string ; structure_links : string } let menus b url = let+ r = Browser.get b url in if r.status <> 200 then Alcotest.failf "%s: status %d" url r.status; match String.split_on_char '\n' r.body with | [menu; menu_of_b; depth_first; whole_tree; breadth_first; structure_links] -> {menu; menu_of_b; depth_first; whole_tree; breadth_first; structure_links} | _ -> Alcotest.failf "%s: unexpected answer %S" url r.body let check = Alcotest.(check string) let simple server = let case = case server in ( "menu" , [ case "current page" (fun b -> let+ m = menus b "/a" in check "menu" {||} m.menu) ; case "page not in the menu" (fun b -> (* The links are relative to the page. *) let+ m = menus b "/section/x" in check "menu" {||} m.menu) ; case "given service" (fun b -> let+ m = menus b "/a" in check "menu" {||} m.menu_of_b) ] ) let level0 ?(a = "") ?(section = "") ?(submenu = "") prefix = Printf.sprintf {||} a prefix section (if prefix = "" then "section/" else "./") submenu let level1 ?(x = "") prefix = Printf.sprintf {||} x prefix prefix let hierarchical server = let case = case server in let current = " eliomtools_current" in ( "hierarchical menu" , [ case "depth first" (fun b -> let* m = menus b "/a" in (* The submenus of the other sections are collapsed. *) check "page of the first level" (level0 ~a:current "") m.depth_first; let+ m = menus b "/section/x" in check "page of a section" (level0 ~section:{| class="eliomtools_current_path"|} ~submenu:(level1 ~x:current "") "../") m.depth_first) ; case "main page of a section" (fun b -> let+ m = menus b "/section/" in check "section" (level0 ~section:{| class="eliomtools_current"|} ~submenu:(level1 "") "../") m.depth_first) ; case "whole tree" (fun b -> let+ m = menus b "/a" in check "all the submenus" (level0 ~a:current ~submenu:(level1 "section/") "") m.whole_tree) ; case "breadth first" (fun b -> (* One list for each level, down to the current page *) let* m = menus b "/a" in check "page of the first level" (level0 ~a:current "") m.breadth_first; let+ m = menus b "/section/x" in check "page of a section" (level0 ~section:{| class="eliomtools_current_path"|} "../" ^ level1 ~x:current "") m.breadth_first) ] ) let links server = let case = case server in ( "structure links" , [ case "main page" (fun b -> let+ m = menus b "/" in check "subsections" {||} m.structure_links) ; case "page of a section" (fun b -> let+ m = menus b "/section/x" in check "section" {||} m.structure_links) ; case "main page of a section" (fun b -> let+ m = menus b "/section/" in check "main page and subsections" {||} m.structure_links) ; case "page not in the site" (fun b -> let+ m = menus b "/b" in check "no link" "" m.structure_links) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-menus" [simple server; hierarchical server; links server]) eliom-13.0.0/test/server/outputs/000077500000000000000000000000001527170563500167235ustar00rootroot00000000000000eliom-13.0.0/test/server/outputs/dune000066400000000000000000000006041527170563500176010ustar00rootroot00000000000000; Actions that reload the page, and the outputs Ocaml and App (executable (name server) (modules server) (libraries eliom.server ocsipersist-sqlite cohttp eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_client uri alcotest)) eliom-13.0.0/test/server/outputs/server.ml000066400000000000000000000120131527170563500205600ustar00rootroot00000000000000(* The test server of test.ml: actions that reload the page, services sending OCaml values, and pages of an application. *) open Eliom open Eliom_test_services module P = Parameter module V = Reference.Volatile (* Actions: each sets the value of the session to its name. The pages show this value. *) let value = V.eref ~scope:Common.default_session_scope "none" let action service name = Registration.Action.register ~service (fun () () -> V.set value name; Lwt.return_unit) let page = get ["page"] P.(opt (string "x")) let () = string page (fun x () -> text (Printf.sprintf "page x=%s value=%s" (Option.value ~default:"none" x) (V.get value))) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text ("fallback value=" ^ V.get value)) let na_action = Service.create ~path:Service.No_path ~meth:(Service.Get P.unit) () let () = action na_action "non-attached" let attached_action = Service.create_attached_get ~fallback ~get_params:P.unit () let () = action attached_action "attached" let () = action (get ["path_action"] P.unit) "path" (* Services sending OCaml values *) let () = Registration.Ocaml.register ~service: (Service.create_ocaml ~path:(Service.Path ["ocaml"]) ~meth:(Service.Get P.(int "i")) ()) (fun i () -> if i < 0 then failwith "negative" else Lwt.return (i + 1)) (* Pages of an application. They tell whether the request is the first one of the client process. *) module Test_app = Registration.App (struct let application_name = "test_app" let global_data_path = None end) let app_page ?(scripts = []) () = Lwt.return Content.Html.F.( html (head (title (txt "app")) scripts) (body [ p [ txt (if Test_app.is_initial_request () then "initial request" else "request of the client process") ] ])) let () = Test_app.register ~service:(get ["app"] P.unit) (fun () () -> app_page ()) let () = Test_app.register ~service:(get ["app_with_script"] P.unit) (fun () () -> app_page ~scripts:[Test_app.application_script ()] ()) let () = Test_app.register ~options:{Registration.do_not_launch = true} ~service:(get ["app_not_launched"] P.unit) (fun () () -> app_page ()) (* Pages with the HTTP status set by their handler *) (* [status_text s] sets the status [s] and shows the status set *) let status_text s = Registration.set_status s; text (match Registration.get_status () with | Some s -> Cohttp.Code.string_of_status (s :> Cohttp.Code.status_code) | None -> "none") let () = string (get ["status"] P.unit) (fun () () -> status_text `Not_found) let () = string (get ["no_status"] P.unit) (fun () () -> text (match Registration.get_status () with | Some _ -> "some" | None -> "none")) (* The status set by the handler wins over the code of the registration. *) let () = Registration.String.register ~code:410 ~service:(get ["status_over_code"] P.unit) (fun () () -> status_text `Not_found) let () = Test_app.register ~service:(get ["app_status"] P.unit) (fun () () -> Registration.set_status `Not_found; app_page ()) (* Actions setting a status: sent as is without reload, dropped when the page is reloaded. *) let status_action = Service.create ~path:Service.No_path ~meth:(Service.Get P.unit) () let () = Registration.Action.register ~service:status_action (fun () () -> Registration.set_status `Bad_request; V.set value "status"; Lwt.return_unit) let () = Registration.Action.register ~options:`NoReload ~service:(get ["status_no_reload"] P.unit) (fun () () -> Registration.set_status `Bad_request; Lwt.return_unit) (* The status set by a handler that raises an exception is dropped: the exception handler of the site answers with its own. *) exception Boom let () = string (get ["status_raise"] P.unit) (fun () () -> Registration.set_status `Not_found; raise Boom) let error_page text = Content.Html.F.(html (head (title (txt text)) []) (body [p [txt text]])) (* The exception handler of the site sends pages of the application: with its own status for the exception of a handler, with status 404 for unknown URLs. *) let () = Registration.set_exn_handler (function | Boom -> Test_app.send (error_page "error page") | Common.Eliom_404 -> Test_app.send ~code:404 (error_page "not found") | e -> Lwt.fail e) (* Links to the actions *) let () = string (get ["link"] P.(string "to")) (fun target () -> text (match target with | "non-attached" -> Eliom_uri.make_string_uri ~absolute_path:true ~service:na_action () | "attached" -> Eliom_uri.make_string_uri ~absolute_path:true ~service:attached_action () | "status" -> Eliom_uri.make_string_uri ~absolute_path:true ~service:status_action () | _ -> invalid_arg target)) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/outputs/test.ml000066400000000000000000000164451527170563500202460ustar00rootroot00000000000000(* Tests of actions that reload the page, of services sending OCaml values, and of the pages of an application. *) open Eliom_test_server open Helpers open Lwt.Syntax (* [body b url] is the body of the page [url], answered with 200 *) let body b url = let+ r = Browser.get b url in check_response url ~status:200 r; r.body (* The number of occurrences of [sub] in [s] *) let occurrences s sub = let n = String.length sub in let rec count i acc = if i + n > String.length s then acc else if String.sub s i n = sub then count (i + n) (acc + 1) else count (i + 1) acc in count 0 0 let check_occurrences msg expected s sub = Alcotest.(check int) msg expected (occurrences s sub) (* [page_url link] is the URL of the page [/page?x=1] with the parameters of [link], the link to a non-attached action *) let page_url link = let uri = Uri.of_string link in Uri.path_and_query (Uri.add_query_param' (Uri.with_path (Uri.remove_query_param uri "to") "/page") ("x", "1")) (* A GET action reloads the page without its coservice. *) let actions server = let case = case server in ( "actions" , [ case "non-attached" (fun b -> (* The other GET parameters of the page are kept. *) let* url = body b "/link?to=non-attached" in let+ r = Browser.get b (page_url url) in check_response "page" ~status:200 ~body:"page x=1 value=non-attached" r) ; case "attached" (fun b -> let* url = body b "/link?to=attached" in let+ r = Browser.get b url in check_response "fallback" ~status:200 ~body:"fallback value=attached" r) ; case "on a path" (fun b -> (* There is no page to reload. *) let* r = Browser.get b "/path_action" in check_response "action" ~status:200 ~body:"" r; let+ r = Browser.get b "/page" in check_response "done" ~status:200 ~body:"page x=none value=path" r) ] ) (* The answer of a service sending an OCaml value to the client-side program *) let ocaml_value r : [`Success of int | `Failure of string] = Eliom_test_client.Ocaml_answer.decode r let ocaml server = let case = case server in ( "Ocaml" , [ case "value" (fun b -> let+ r = Browser.get b "/ocaml?i=1" in check_response "answer" ~status:200 r; match ocaml_value r with | `Success n -> Alcotest.(check int) "value" 2 n | `Failure _ -> Alcotest.fail "failure") ; case "exception" (fun b -> (* The client gets the code of the error, which the server logs. *) let+ r = Browser.get b "/ocaml?i=-1" in check_response "answer" ~status:200 r; match ocaml_value r with | `Failure code -> Alcotest.(check int) "code" 6 (String.length code) | `Success _ -> Alcotest.fail "success") ] ) let app server = let case = case server in ( "App" , [ case "page" (fun b -> let+ r = Browser.get b "/app" in check_response "page" ~status:200 r; Alcotest.(check (option string)) "application" (Some "test_app") (Browser.header r "x-eliom-application"); Alcotest.(check (option string)) "content type" (Some "text/html") (Browser.header r "content-type"); check_occurrences "data of the site" 1 r.body "__eliom_appl_sitedata ="; check_occurrences "data of the request" 1 r.body "__eliom_request_data ="; check_occurrences "program" 1 r.body {|src="./test_app.js"|}; check_occurrences "content" 1 r.body "

initial request

") ; case "program given by the page" (fun b -> let+ page = body b "/app_with_script" in check_occurrences "program" 1 page {|src="./test_app.js"|}) ; case "not launched" (fun b -> let+ page = body b "/app_not_launched" in check_occurrences "program" 0 page "test_app.js"; check_occurrences "data of the request" 0 page "__eliom_request_data"; check_occurrences "content" 1 page "

initial request

") ; case "request of the client process" (fun b -> (* The tab cookies of the first page tell the application. *) let tab = Eliom_test_client.Tab.create b in let* r = Eliom_test_client.Tab.get tab "/app" in check_occurrences "first" 1 r.body "

initial request

"; let+ r = Eliom_test_client.Tab.get tab "/app" in check_occurrences "next" 1 r.body "

request of the client process

") ; case "unknown URL" (fun b -> (* The exception handler of the site sends a page of the application, with its status, to the browser and to the client process alike. *) let check msg (r : Browser.response) = check_response msg ~status:404 r; Alcotest.(check (option string)) (msg ^ ": application") (Some "test_app") (Browser.header r "x-eliom-application"); check_occurrences (msg ^ ": content") 1 r.body "

not found

" in let* r = Browser.get b "/unknown" in check "browser" r; let tab = Eliom_test_client.Tab.create b in let* _ = Eliom_test_client.Tab.get tab "/app" in let+ r = Eliom_test_client.Tab.get ~expecting_process_page:true tab "/unknown" in check "client process" r) ] ) (* The HTTP status set by the handler with [Registration.set_status] *) let status server = let case = case server in ( "status" , [ case "set by the handler" (fun b -> let+ r = Browser.get b "/status" in check_response "page" ~status:404 ~body:"404 Not Found" r) ; case "none by default" (fun b -> let+ r = Browser.get b "/no_status" in check_response "page" ~status:200 ~body:"none" r) ; case "over the code of the registration" (fun b -> let+ r = Browser.get b "/status_over_code" in check_response "page" ~status:404 r) ; case "page of an application" (fun b -> let+ r = Browser.get b "/app_status" in check_response "page" ~status:404 r; Alcotest.(check (option string)) "application" (Some "test_app") (Browser.header r "x-eliom-application")) ; case "action without reload" (fun b -> let+ r = Browser.get b "/status_no_reload" in check_response "action" ~status:400 ~body:"" r) ; case "dropped when the page is reloaded" (fun b -> let* url = body b "/link?to=status" in let+ r = Browser.get b (page_url url) in check_response "page" ~status:200 ~body:"page x=1 value=status" r) ; case "dropped when the handler raises" (fun b -> let+ r = Browser.get b "/status_raise" in check_response "error page" ~status:200 r; check_occurrences "content" 1 r.body "

error page

") ; case "page of an application, from the client process" (fun b -> let tab = Eliom_test_client.Tab.create b in let* _ = Eliom_test_client.Tab.get tab "/app" in let+ r = Eliom_test_client.Tab.get ~expecting_process_page:true tab "/app_status" in check_response "page" ~status:404 r; Alcotest.(check (option string)) "application" (Some "test_app") (Browser.header r "x-eliom-application")) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-outputs" [actions server; ocaml server; app server; status server]) eliom-13.0.0/test/server/server_function/000077500000000000000000000000001527170563500204135ustar00rootroot00000000000000eliom-13.0.0/test/server/server_function/dune000066400000000000000000000006721527170563500212760ustar00rootroot00000000000000; Server functions, called as the client-side program does (executable (name server) (modules server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services eliom_test_client)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_client alcotest)) eliom-13.0.0/test/server/server_function/server.ml000066400000000000000000000023101527170563500222470ustar00rootroot00000000000000(* The test server of test.ml: server functions, whose services are sent to the test as the client-side program gets them. *) open Eliom open Eliom_test_services module P = Parameter module Info = Eliom_test_client.Service_info (* [info path f] registers the service /path, whose answer is the service of the server function [f] *) let info path f = string (get [path] P.unit) (fun () () -> text (Info.to_string (Info.of_server_function f))) let () = info "incr" (Client.server_function [%json: int] (fun i -> if i < 0 then failwith "negative" else Lwt.return (i + 1))) let () = info "with_error_handler" (Client.server_function ~error_handler:(fun _ -> Lwt.return (-1)) [%json: int] Lwt.return) let () = info "once" (Client.server_function ~max_use:1 [%json: int] Lwt.return) (* A server function of the session, created by a request *) let () = string (get ["of_the_session"] P.unit) (fun () () -> let f = Client.server_function ~scope:Common.default_session_scope [%json: string] (fun s -> Lwt.return ("of the session " ^ s)) in text (Info.to_string (Info.of_server_function f))) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/server_function/test.ml000066400000000000000000000061231527170563500217260ustar00rootroot00000000000000(* Tests of server functions, called as the client-side program does: a POST request with the argument in JSON, answered with an OCaml value. *) open Eliom_test_server open Eliom_test_client open Lwt.Syntax let info tab path = let* r = Tab.get tab path in if r.status <> 200 then Alcotest.failf "%s: status %d" path r.status; Lwt.return (Service_info.of_string r.body) let call = Service_info.post (* A server function that is gone: as for any non-attached coservice not found, the page at the path of the request answers, not an OCaml value. *) let gone msg (r : Browser.response) = Alcotest.(check int) (msg ^ ": status") 200 r.status; Alcotest.check_raises msg (Failure "Ocaml_answer: not an answer of an OCaml service") (fun () -> ignore (Ocaml_answer.decode r : [`Success of unit | `Failure of string])) let success msg expected tab info argument = let+ r = call tab info argument in match Ocaml_answer.decode r with | `Success v -> Alcotest.(check int) msg expected v | `Failure code -> Alcotest.failf "%s: failure %s" msg code let case server name f = Alcotest.test_case name `Quick (fun () -> Lwt_main.run (f (Tab.create (Browser.create server)))) let server_functions server = let case = case server in ( "server functions" , [ case "call" (fun tab -> let* info = info tab "/incr" in success "result" 2 tab info "1") ; case "exception" (fun tab -> let* info = info tab "/incr" in let+ r = call tab info "-1" in match Ocaml_answer.decode r with | `Failure code -> Alcotest.(check int) "code" 6 (String.length code) | `Success (_ : int) -> Alcotest.fail "success") ; case "malformed argument" (fun tab -> let* info = info tab "/incr" in let+ r = call tab info "x" in Alcotest.(check int) "typing error" 400 r.status) ; case "error handler" (fun tab -> (* The answer is compared with the encoding of the expected one: an answer of another shape cannot be decoded safely. *) let* info = info tab "/with_error_handler" in let+ r = call tab info "x" in Alcotest.(check string) "result of the handler" (Eliom.Types.encode_eliom_data {Eliom.Runtime.ecs_request_data = [||]; ecs_data = `Success (-1)}) r.body) ; case "max_use" (fun tab -> let* info = info tab "/once" in let* () = success "first" 1 tab info "1" in let+ r = call tab info "1" in gone "second" r) ; case "of the session" (fun tab -> let* info = info tab "/of_the_session" in let* r = call tab info "\"s\"" in (match Ocaml_answer.decode r with | `Success v -> Alcotest.(check string) "own session" "of the session s" v | `Failure code -> Alcotest.failf "failure %s" code); let other = Tab.create (Browser.create server) in let+ r = call other info "\"s\"" in gone "other browser" r) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-function" [server_functions server]) eliom-13.0.0/test/server/services/000077500000000000000000000000001527170563500170235ustar00rootroot00000000000000eliom-13.0.0/test/server/services/dune000066400000000000000000000004071527170563500177020ustar00rootroot00000000000000(executable (name server) (modules server) (libraries eliom.server ocsipersist-sqlite cohttp eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server uri alcotest)) eliom-13.0.0/test/server/services/server.ml000066400000000000000000000231221527170563500206630ustar00rootroot00000000000000(* The test server of test.ml. Most services answer in plain text, for simple assertions. *) open Eliom open Eliom_test_services module P = Parameter let post path get_params post_params = Service.create ~path:(Service.Path path) ~meth:(Service.Post (get_params, post_params)) () (* Dispatch and parameters *) let hello = get ["hello"] P.unit let () = string hello (fun () () -> text "hello") let () = string (get ["params"] P.(int "i" ** string "s")) (fun (i, s) () -> text (Printf.sprintf "i=%d s=%s" i s)) let () = string (get ["opt"] P.(opt (int "i"))) (fun i () -> text (match i with None -> "none" | Some i -> string_of_int i)) let () = string (get ["list"] P.(list "l" (string "x"))) (fun l () -> text (String.concat "," l)) let () = string (get ["set"] P.(set int "i")) (fun l () -> text (String.concat "," (List.map string_of_int (List.sort compare l)))) let suffix_service = get ["suffix"] P.(suffix (int "i" ** string "s")) let () = string (get ["suffix_link"] P.unit) (fun () () -> text (Eliom_uri.make_string_uri ~absolute_path:true ~service:suffix_service (3, "x/y"))) let () = string (get ["files"] P.(suffix (all_suffix "path"))) (fun path () -> text (String.concat "|" path)) let () = string (get ["relative"] P.(suffix (string "s"))) (fun _ () -> text (Eliom_uri.make_string_uri ~service:hello ())) let () = string (get ["tree"] P.(suffix (all_suffix_string "path"))) (fun path () -> text path) let () = string (get ["info"] P.(suffix (string "s"))) (fun _ () -> text (String.concat " " (List.map (String.concat "|") [ Request_info.get_current_sub_path () ; Request_info.get_original_full_path () ]))) let () = string (get ["client"] P.unit) (fun () () -> text (match Request_info.get_client_conn () with | `Inet _ -> "inet" | `Forwarded_for ip -> "forwarded " ^ ip | `Unix _ -> "unix" | `Unknown -> "unknown")) let () = string suffix_service (fun (i, s) () -> text (Printf.sprintf "i=%d s=%s" i s)) let form = get ["form"] P.unit let () = string form (fun () () -> text "get") let () = string (post ["form"] P.unit P.(string "v")) (fun () v -> text ("post " ^ v)) let () = string (post ["post_int"] P.unit P.(int "n")) (fun () n -> text (string_of_int n)) let () = string (get ["dir"; ""] P.unit) (fun () () -> text "directory") let () = string (get ["prod"] P.(suffix_prod (int "i") (string "q"))) (fun (i, q) () -> text (Printf.sprintf "i=%d q=%s" i q)) (* Two services on the same path: when the parameters do not match the first one, the next one is tried. *) let () = string (get ["alternatives"] P.(int "i")) (fun i () -> text ("int " ^ string_of_int i)) let () = string (get ["alternatives"] P.(string "s")) (fun s () -> text ("string " ^ s)) (* Two services accepting the same parameters: the one with the higher priority is tried first, although it is registered after the other. *) let () = string (get ["priority"] P.(int "x")) (fun i () -> text ("int " ^ string_of_int i)) let () = string (get ~priority:1 ["priority"] P.(string "x")) (fun s () -> text ("string " ^ s)) let temporary = get ["temporary"] P.unit let () = string temporary (fun () () -> text "temporary") let () = string (get ["unregister"] P.unit) (fun () () -> Service.unregister temporary; text "unregistered") let () = string (get ["failure"] P.unit) (fun () () -> failwith "handler failure") (* Outputs *) let () = Registration.Html.register ~service:(get ["html"] P.unit) (fun () () -> Lwt.return Content.Html.F.( html (head (title (txt "title")) []) (body [p [txt "body"]]))) let () = Registration.Html_text.register ~service:(get ["html_text"] P.unit) (fun () () -> Lwt.return "

text

") let () = Registration.CssText.register ~options:3600 ~service:(get ["css"] P.unit) (fun () () -> Lwt.return "p {}") let () = string ~options:0 (get ["no_cache"] P.unit) (fun () () -> text "no cache") let () = string ~code:201 ~headers:(Cohttp.Header.init_with "X-Test" "yes") (get ["code"] P.unit) (fun () () -> text "created") let () = Registration.Unit.register ~service:(get ["unit"] P.unit) (fun () () -> Lwt.return_unit) let () = Registration.Action.register ~options:`NoReload ~service:(post ["action"] P.unit P.(string "v")) (fun () _ -> Lwt.return_unit) let () = Registration.Redirection.register ~service:(get ["redirect"] P.unit) (fun () () -> Lwt.return (Registration.Redirection hello)) let () = Registration.Redirection.register ~options:`MovedPermanently ~service:(get ["moved"] P.unit) (fun () () -> Lwt.return (Registration.Redirection hello)) let () = Registration.Redirection.register ~options:`NotModified ~service:(get ["not_modified"] P.unit) (fun () () -> Lwt.return (Registration.Redirection hello)) let () = Registration.String_redirection.register ~service:(get ["redirect_string"] P.unit) (fun () () -> Lwt.return "http://example.org/elsewhere") let () = Registration.File.register ~options:60 ~service:(get ["file"] P.unit) (fun () () -> Lwt.return "file.txt") let () = Registration.File.register ~service:(get ["missing_file"] P.unit) (fun () () -> Lwt.return "missing.txt") let () = Registration.File_ct.register ~options:60 ~service:(get ["file_ct"] P.unit) (fun () () -> Lwt.return ("file.txt", "text/x-test")) let () = Registration.Any.register ~service:(get ["any"] P.(bool "html")) (fun html () -> if html then Registration.Html_text.send "

any

" else Lwt.map Registration.cast_unknown_content_kind (Registration.String.send ("any", "text/plain"))) (* Non-localized parameters: [persistent_nl] is kept by default in the links of the pages that receive it, [transient_nl] only with [~keep_nl_params:`All] *) let persistent_nl = P.make_non_localized_parameters ~prefix:"test" ~name:"persistent" ~persistent:true P.(string "v") let transient_nl = P.make_non_localized_parameters ~prefix:"test" ~name:"transient" P.(string "v") let nl_target = get ["nl"; "target"] P.unit (* A target whose links keep all the non-localized parameters by default *) let nl_target_all = Service.create ~keep_nl_params:`All ~path:(Service.Path ["nl"; "target_all"]) ~meth:(Service.Get P.unit) () let () = List.iter (fun service -> string service (fun () () -> let value nl = Option.value ~default:"none" (P.get_non_localized_get_parameters nl) in text (Printf.sprintf "persistent=%s transient=%s" (value persistent_nl) (value transient_nl)))) [nl_target; nl_target_all] (* /nl/link is a link to /nl/target with both parameters; /nl/link?keep= is a link to a target without parameters, keeping those of the request as [keep] says: to /nl/target, to /nl/target_all, or to /nl/target with the persistent parameter preapplied *) let () = string (get ["nl"; "link"] P.(opt (string "keep"))) (fun keep () -> let uri ?keep_nl_params ?nl_params service = Eliom_uri.make_string_uri ~absolute_path:true ?keep_nl_params ?nl_params ~service () in let preapplied = Service.preapply ~service: (Service.add_non_localized_get_parameters ~params:persistent_nl ~service:nl_target) ((), "q") in text (match keep with | None -> uri ~nl_params: P.( add_nl_parameter (add_nl_parameter empty_nl_params_set persistent_nl "p") transient_nl "t") nl_target | Some "default" -> uri nl_target | Some "all" -> uri ~keep_nl_params:`All nl_target | Some "persistent" -> uri ~keep_nl_params:`Persistent nl_target | Some "none" -> uri ~keep_nl_params:`None nl_target | Some "service" -> uri nl_target_all | Some "service_none" -> uri ~keep_nl_params:`None nl_target_all | Some "preapplied" -> uri preapplied | Some "preapplied_all" -> uri ~keep_nl_params:`All preapplied | Some k -> invalid_arg k)) (* An action that sets a cookie of path /cookie_page/a, then reloads the page, which tells whether the request has the cookie *) let cookie_page = get ["cookie_page"] P.(suffix (all_suffix "s")) let () = string cookie_page (fun _ () -> text (match Ocsigen_cookie_map.Map_inner.find_opt "test_action" (Request_info.get_cookies ()) with | Some v -> "cookie " ^ v | None -> "no cookie")) let set_cookie = Service.create ~path:Service.No_path ~meth:(Service.Post (P.unit, P.unit)) () let () = Registration.Action.register ~options:`Reload ~service:set_cookie (fun () () -> State.set_cookie ~path:["cookie_page"; "a"] ~name:"test_action" ~value:"set" (); Lwt.return_unit) (* The POST parameters of the action, one per line, the name and the value separated by a tab *) let () = string (get ["set_cookie"] P.unit) (fun () () -> let _, _, _, params = Eliom_uri.make_post_uri_components ~service:set_cookie () () in text (String.concat "\n" (List.map (fun (n, v) -> n ^ "\t" ^ v) params))) (* The file served by /file, in the directory of the server *) let () = Out_channel.with_open_bin (Filename.concat Sys.argv.(1) "file.txt") (fun oc -> output_string oc "file content") let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/services/test.ml000066400000000000000000000330301527170563500203330ustar00rootroot00000000000000open Eliom_test_server open Helpers let check_header msg name expected r = Alcotest.(check (option string)) msg expected (Browser.header r name) (* Absolute locations: the host and port depend on the connection. *) let check_location msg expected r = Alcotest.(check (option string)) msg (Some expected) (Option.map (fun l -> Uri.path_and_query (Uri.of_string l)) (Browser.header r "location")) let content_type r = Option.map (fun ct -> List.hd (String.split_on_char ';' ct)) (Browser.header r "content-type") open Lwt.Syntax let dispatch server = let case = case server in ( "dispatch" , [ case "path" (fun b -> let+ r = Browser.get b "/hello" in check_response "hello" ~status:200 ~body:"hello" r) ; case "unknown path" (fun b -> let+ r = Browser.get b "/nope" in check_response "404" ~status:404 r) ; case "directory" (fun b -> let* r = Browser.get b "/dir/" in check_response "with slash" ~status:200 ~body:"directory" r; let+ r = Browser.get b "/dir" in check_response "without slash" ~status:301 r; check_location "location" "/dir/" r) ; case "GET and POST" (fun b -> let* r = Browser.get b "/form" in check_response "GET" ~status:200 ~body:"get" r; let+ r = Browser.post b "/form" ["v", "x y"] in check_response "POST" ~status:200 ~body:"post x y" r) ; case "POST on a GET service" (fun b -> let+ r = Browser.post b "/hello" ["v", "x"] in check_response "404" ~status:404 r) ; case "next service" (fun b -> let* r = Browser.get b "/alternatives?i=1" in check_response "first service" ~status:200 ~body:"int 1" r; let+ r = Browser.get b "/alternatives?s=x" in check_response "second service" ~status:200 ~body:"string x" r) ; case "priority" (fun b -> let+ r = Browser.get b "/priority?x=1" in check_response "higher priority" ~status:200 ~body:"string 1" r) ; case "unregister" (fun b -> let* r = Browser.get b "/temporary" in check_response "before" ~status:200 ~body:"temporary" r; let* _ = Browser.get b "/unregister" in let+ r = Browser.get b "/temporary" in check_response "after" ~status:404 r) ; case "handler failure" (fun b -> let+ r = Browser.get b "/failure" in check_response "500" ~status:500 r; Alcotest.(check bool) "no details" false (contains r.body "handler failure")) ] ) let parameters server = let case = case server in ( "parameters" , [ case "atoms" (fun b -> let+ r = Browser.get b "/params?i=12&s=a+b%26c" in check_response "decoded" ~status:200 ~body:"i=12 s=a b&c" r) ; case "suffix" (fun b -> let* r = Browser.get b "/suffix/3/x%20y%26%C3%A9" in check_response "suffix" ~status:200 ~body:"i=3 s=x y&\xc3\xa9" r; let+ r = Browser.get b "/suffix/x/y" in check_response "wrong type" ~status:400 r) ; case "suffix and parameters" (fun b -> let+ r = Browser.get b "/prod/3?q=a" in check_response "decoded" ~status:200 ~body:"i=3 q=a" r) ; case "whole suffix as a parameter" (fun b -> (* The version of the service without suffix redirects to the one with suffix, without ".." segments. *) let+ r = Browser.get b "/files/__eliom_suffix__?path=../a/../b" in check_response "redirection" ~status:307 r; check_location "location" "/files/a/b" r) ; case "optional" (fun b -> let* r = Browser.get b "/opt" in check_response "absent" ~status:200 ~body:"none" r; let+ r = Browser.get b "/opt?i=4" in check_response "present" ~status:200 ~body:"4" r) ; case "list and set" (fun b -> let* r = Browser.get b "/list?l.x[0]=a&l.x[1]=b" in check_response "list" ~status:200 ~body:"a,b" r; let+ r = Browser.get b "/set?i=3&i=1&i=2" in check_response "set" ~status:200 ~body:"1,2,3" r) ; case "wrong type" (fun b -> let+ r = Browser.get b "/params?i=x&s=a" in check_response "400" ~status:400 r) ; case "missing parameter" (fun b -> let+ r = Browser.get b "/params?i=1" in check_response "400" ~status:400 r) ; case "unexpected parameter" (fun b -> let+ r = Browser.get b "/params?i=1&s=a&z=2" in check_response "400" ~status:400 r) ; case "POST parameters" (fun b -> let* r = Browser.post b "/post_int" ["n", "7"] in check_response "decoded" ~status:200 ~body:"7" r; let* r = Browser.post b "/post_int" ["n", "x"] in check_response "wrong type" ~status:400 r; let* r = Browser.post b "/post_int" [] in check_response "missing" ~status:400 r; let+ r = Browser.post b "/post_int?z=1" ["n", "7"] in check_response "unexpected GET parameter" ~status:400 r) ] ) (* Values of suffix parameters containing slashes, written %2F *) let suffixes server = let case = case server in ( "suffixes" , [ case "slash in a value" (fun b -> let+ r = Browser.get b "/suffix/3/x%2Fy" in check_response "decoded" ~status:200 ~body:"i=3 s=x/y" r) ; case "generated URL" (fun b -> let* r = Browser.get b "/suffix_link" in check_response "URL" ~status:200 ~body:"/suffix/3/x%2Fy" r; let+ r = Browser.get b r.body in check_response "followed" ~status:200 ~body:"i=3 s=x/y" r) ; case "whole suffix" (fun b -> let* r = Browser.get b "/files/a/b%2Fc" in check_response "split" ~status:200 ~body:"a|b|c" r; let+ r = Browser.get b "/files/a/..%2F..%2Fsecret" in check_response "no dot dot" ~status:200 ~body:"a|secret" r) ; case "whole suffix as a string" (fun b -> let+ r = Browser.get b "/tree/a/b%2Fc/..%2Fd" in check_response "no dot dot" ~status:200 ~body:"a/b/c/d" r) ; case "dot dot in a value" (fun b -> (* Only the ".." segments of the path are removed. *) let+ r = Browser.get b "/suffix/3/..%2Fetc" in check_response "kept" ~status:200 ~body:"i=3 s=../etc" r) ; case "malformed escape" (fun b -> (* The segment is kept as it is, as by Ocsigen Server. *) let+ r = Browser.get b "/suffix/3/%ZZ" in check_response "kept" ~status:200 ~body:"i=3 s=%ZZ" r) ; case "version without suffix" (fun b -> let+ r = Browser.get b "/suffix/__eliom_suffix__?i=3&s=x%2Fy" in check_response "redirection" ~status:307 r; check_location "location" "/suffix/3/x%2Fy" r) ; case "relative URL" (fun b -> (* The browser sees two segments in /relative/a%2Fb. *) let+ r = Browser.get b "/relative/a%2Fb" in check_response "one level up" ~status:200 ~body:"../hello" r) ; case "request information" (fun b -> let+ r = Browser.get b "/info/a%2Fb" in check_response "paths" ~status:200 ~body:"info|a/b info|a/b" r) ; case "client connection" (fun b -> (* The test server listens on a Unix socket. *) let+ r = Browser.get b "/client" in check_response "Unix socket" ~status:200 ~body:"unix" r) ] ) let outputs server = let case = case server in ( "outputs" , [ case "Html" (fun b -> let+ r = Browser.get b "/html" in check_response "status" ~status:200 r; Alcotest.(check (option string)) "content type" (Some "text/html") (content_type r); Alcotest.(check bool) "document" true (contains r.body "

body

")) ; case "Html_text" (fun b -> let+ r = Browser.get b "/html_text" in check_response "body" ~status:200 ~body:"

text

" r; Alcotest.(check (option string)) "content type" (Some "text/html") (content_type r)) ; case "CssText" (fun b -> let+ r = Browser.get b "/css" in check_response "body" ~status:200 ~body:"p {}" r; Alcotest.(check (option string)) "content type" (Some "text/css") (content_type r); check_header "cache" "cache-control" (Some "max-age=3600") r) ; case "no default charset" (fun b -> (* The test server has no default charset. *) let+ r = Browser.get b "/hello" in check_header "content type" "content-type" (Some "text/plain") r) ; case "no cache" (fun b -> let+ r = Browser.get b "/no_cache" in check_header "cache" "cache-control" (Some "no-cache") r) ; case "code and headers" (fun b -> let+ r = Browser.get b "/code" in check_response "code" ~status:201 ~body:"created" r; check_header "header" "x-test" (Some "yes") r) ; case "Unit" (fun b -> let+ r = Browser.get b "/unit" in check_response "no content" ~status:204 ~body:"" r) ; case "Action" (fun b -> let+ r = Browser.post b "/action" ["v", "x"] in check_response "no content" ~status:204 ~body:"" r) ; case "Redirection" (fun b -> let* r = Browser.get b "/redirect" in check_response "found" ~status:302 r; check_header "location" "location" (Some "hello") r; let* r = Browser.get b "/moved" in check_response "moved permanently" ~status:301 r; check_header "moved location" "location" (Some "hello") r; let+ r = Browser.get b "/not_modified" in check_response "not modified" ~status:304 r) ; case "String_redirection" (fun b -> let+ r = Browser.get b "/redirect_string" in check_response "found" ~status:302 r; check_header "location" "location" (Some "http://example.org/elsewhere") r) ; case "File" (fun b -> let* r = Browser.get b "/file" in check_response "content" ~status:200 ~body:"file content" r; Alcotest.(check (option string)) "content type" (Some "text/plain") (content_type r); check_header "cache" "cache-control" (Some "max-age=60") r; let+ r = Browser.get b "/missing_file" in check_response "missing" ~status:404 r) ; case "File_ct" (fun b -> let+ r = Browser.get b "/file_ct" in check_response "content" ~status:200 ~body:"file content" r; Alcotest.(check (option string)) "content type" (Some "text/x-test") (content_type r); check_header "cache" "cache-control" (Some "max-age=60") r) ; case "Any" (fun b -> let* r = Browser.get b "/any?html=on" in check_response "HTML" ~status:200 ~body:"

any

" r; Alcotest.(check (option string)) "HTML content type" (Some "text/html") (content_type r); let+ r = Browser.get b "/any" in check_response "text" ~status:200 ~body:"any" r; Alcotest.(check (option string)) "text content type" (Some "text/plain") (content_type r)) ] ) (* [body b url] is the body of the page [url], answered with 200 *) let body b url = let+ r = Browser.get b url in check_response url ~status:200 r; r.body let non_localized server = let case = case server in (* A link given by /nl/link?keep= during a request that has the two non-localized parameters *) let link b keep = let* url = body b "/nl/link" in let query = Option.value ~default:"" (Uri.verbatim_query (Uri.of_string url)) in body b ("/nl/link?keep=" ^ keep ^ "&" ^ query) in ( "non-localized parameters" , [ case "read by a service" (fun b -> let* url = body b "/nl/link" in let+ r = Browser.get b url in check_response "values" ~status:200 ~body:"persistent=p transient=t" r) ; case "kept in links" (fun b -> Lwt_list.iter_s (fun (keep, expected) -> let* url = link b keep in let+ r = Browser.get b url in check_response keep ~status:200 ~body:expected r) [ "default", "persistent=p transient=none" ; "persistent", "persistent=p transient=none" ; "all", "persistent=p transient=t" ; "none", "persistent=none transient=none" (* The default of the target service, overridden by the link *) ; "service", "persistent=p transient=t" ; "service_none", "persistent=none transient=none" (* A preapplied value replaces the value of the request. *) ; "preapplied", "persistent=q transient=none" ; "preapplied_all", "persistent=q transient=t" ]) ] ) let actions server = let case = case server in (* [set_cookie b path] posts the action /set_cookie, which sets a cookie of path /cookie_page/a, from the page [path] *) let set_cookie b path = let* params = body b "/set_cookie" in let params = List.map (fun p -> match String.index_opt p '\t' with | Some i -> String.sub p 0 i, String.sub p (i + 1) (String.length p - i - 1) | None -> Alcotest.failf "wrong POST parameter %S" p) (String.split_on_char '\n' params) in Browser.post b path params in ( "actions" , [ case "reload" (fun b -> (* The page is generated again, with the cookies set by the action *) let+ r = set_cookie b "/cookie_page/a/b" in check_response "page" ~status:200 ~body:"cookie set" r) ; case "cookie of a path, and a slash in a segment" (fun b -> (* The segment a%2Fb is not a/b: the cookie of path /cookie_page/a is not for the page, as a browser would not send it. *) let+ r = set_cookie b "/cookie_page/a%2Fb" in check_response "page" ~status:200 ~body:"no cookie" r) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-services" [ dispatch server ; parameters server ; suffixes server ; outputs server ; non_localized server ; actions server ]) eliom-13.0.0/test/server/services_lib/000077500000000000000000000000001527170563500176515ustar00rootroot00000000000000eliom-13.0.0/test/server/services_lib/dune000066400000000000000000000002101527170563500205200ustar00rootroot00000000000000; Helpers of the test servers, to create and register services. (library (name eliom_test_services) (libraries eliom.server cohttp)) eliom-13.0.0/test/server/services_lib/eliom_test_services.ml000066400000000000000000000004401527170563500242500ustar00rootroot00000000000000open Eliom let text s = Lwt.return (s, "text/plain") let get ?priority path params = Service.create ?priority ~path:(Service.Path path) ~meth:(Service.Get params) () let string ?options ?code ?headers service f = Registration.String.register ?options ?code ?headers ~service f eliom-13.0.0/test/server/services_lib/eliom_test_services.mli000066400000000000000000000022001527170563500244150ustar00rootroot00000000000000(** Helpers of the test servers: services answering in plain text. *) val text : string -> (string * string) Lwt.t (** [text s] is the answer [s], in plain text. *) val get : ?priority:int -> Eliom.Lib.Url.path -> ('a, ([< `WithSuffix | `WithoutSuffix] as 'b), 'c) Eliom.Service.params -> ( 'a , unit , Eliom.Service.get , Eliom.Service.att , Eliom.Service.non_co , Eliom.Service.non_ext , Eliom.Service.reg , 'b , 'c , unit , Eliom.Service.non_ocaml ) Eliom.Service.t (** [get ?priority path params] is a new GET service on [path]. *) val string : ?options:Eliom.Registration.String.options -> ?code:int -> ?headers:Cohttp.Header.t -> ( 'a , 'b , 'c , 'd , 'e , Eliom.Service.non_ext , Eliom.Service.reg , [< `WithSuffix | `WithoutSuffix] , 'f , 'g , Eliom.Registration.String.return ) Eliom.Service.t -> ('a -> 'b -> Eliom.Registration.String.page Lwt.t) -> unit (** [string service f] registers [f] as the handler of [service], with {!Eliom.Registration.String}. *) eliom-13.0.0/test/server/site_wide/000077500000000000000000000000001527170563500171545ustar00rootroot00000000000000eliom-13.0.0/test/server/site_wide/anonymous_server.ml000066400000000000000000000021401527170563500231210ustar00rootroot00000000000000(* At most two anonymous coservices of the global table created during requests. *) open Eliom open Eliom_test_services module P = Parameter let () = State.set_default_max_anonymous_services_per_site ~override_configfile:true 2 let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let uri service = Eliom_uri.make_string_uri ~absolute_path:true ~service () (* An anonymous coservice created during the initialisation of the site *) let initial = Service.create_attached_get ~fallback ~get_params:P.unit () let () = Registration.String.register ~service:initial (fun () () -> text "initial") let () = string (get ["initial"] P.unit) (fun () () -> text (uri initial)) (* An anonymous coservice of the global table, created by the request *) let () = string (get ["coservice"] P.(string "v")) (fun v () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in Registration.String.register ~service (fun () () -> text ("coservice " ^ v)); text (uri service)) let () = Services.start () eliom-13.0.0/test/server/site_wide/dune000066400000000000000000000012071527170563500200320ustar00rootroot00000000000000; Settings of the states that apply to a whole site: each server has its own. (executables (names timeouts_server no_group_server gc_server groups_server anonymous_server) (modules services timeouts_server no_group_server gc_server groups_server anonymous_server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps timeouts_server.exe no_group_server.exe gc_server.exe groups_server.exe anonymous_server.exe) (libraries eliom_test_server lwt.unix alcotest)) eliom-13.0.0/test/server/site_wide/gc_server.ml000066400000000000000000000004471527170563500214720ustar00rootroot00000000000000(* Volatile data sessions expire after 1 s and are collected every second. *) let () = Eliom.State.set_default_global_volatile_data_state_timeout ~cookie_level:`Session ~override_configfile:true (Some 1.); Eliom.Config.set_data_session_gc_frequency (Some 1) let () = Services.start () eliom-13.0.0/test/server/site_wide/groups_server.ml000066400000000000000000000033571527170563500224230ustar00rootroot00000000000000(* The limit of session groups of the site, set with a session group scope. It applies to the whole server: each run tests one kind of state, and no session is opened without a group. *) open Eliom open Eliom_test_services module P = Parameter module V = Reference.Volatile let session_scope = Common.default_session_scope let group_scope = (Common.default_group_scope :> Common.user_scope) (* Services: the browser joins a group of services, then gets a coservice of its session, and sets the limit of groups *) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let () = string (get ["service"; "join"] P.(string "name")) (fun name () -> State.set_service_session_group ~scope:session_scope name; let service = Service.create_attached_get ~fallback ~get_params:P.unit () in Registration.String.register ~scope:session_scope ~service (fun () () -> text "coservice"); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) let () = string (get ["service"; "max_groups"] P.(int "n")) (fun n () -> State.set_max_service_states_in_parent ~scope:group_scope n; text "set") (* Data: the browser joins a group of data, then sets a session reference, and sets the limit of groups *) let () = string (get ["data"; "join"] P.(string "name" ** string "v")) (fun (name, v) () -> State.set_volatile_data_session_group ~scope:session_scope name; V.set Services.session_value v; text "joined") let () = string (get ["data"; "max_groups"] P.(int "n")) (fun n () -> State.set_max_volatile_data_states_in_parent ~scope:group_scope n; text "set") let () = Services.start () eliom-13.0.0/test/server/site_wide/no_group_server.ml000066400000000000000000000016341527170563500227300ustar00rootroot00000000000000(* At most two volatile data sessions without a group in the site. *) open Eliom open Eliom_test_services module P = Parameter let () = State.set_default_max_volatile_data_sessions_without_group ~override_configfile:true 2 (* The limit of the parent of the session of the request, which has no group *) let () = string (get ["max_in_parent"] P.(int "n")) (fun n () -> State.set_max_volatile_data_states_in_parent ~scope:(Common.default_session_scope :> Common.user_scope) n; text "set") (* The limit of the sessions without a group of the site *) let () = string (get ["max_without_group"] P.(int "n")) (fun n () -> match State.set_default_max_volatile_data_sessions_without_group ~override_configfile:true n with | () -> text "set" | exception Invalid_argument _ -> text "invalid") let () = Services.start () eliom-13.0.0/test/server/site_wide/services.ml000066400000000000000000000007741527170563500213410ustar00rootroot00000000000000open Eliom open Eliom_test_services module P = Parameter module V = Reference.Volatile let session_value = V.eref ~scope:Common.default_session_scope "" let start () = string (get ["set"] P.(string "v")) (fun v () -> V.set session_value v; text "set"); string (get ["get"] P.unit) (fun () () -> text (V.get session_value)); string (get ["count"] P.unit) (fun () () -> text (string_of_int (State.number_of_volatile_data_cookies ()))); Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/site_wide/services.mli000066400000000000000000000006351527170563500215060ustar00rootroot00000000000000(** Services of the test servers of test.ml, which answer in plain text: - [/set?v=] and [/get] set and read a session reference, - [/count] is the number of volatile data sessions of the server. *) val session_value : string Eliom.Reference.Volatile.eref (** The session reference of [/set] and [/get]. *) val start : unit -> unit (** [start ()] registers the common services and starts the server. *) eliom-13.0.0/test/server/site_wide/test.ml000066400000000000000000000320671527170563500204750ustar00rootroot00000000000000(* Tests of the settings of states that apply to a whole site: global and default timeouts, scope hierarchies, session groups, the limit of sessions without a group and the collection of expired states. *) open Eliom_test_server open Helpers open Lwt.Syntax let sleep = Lwt_unix.sleep (* [with_setting b set reset f] runs [f ()] with the setting of the site [set], then restores it with [reset]. *) let with_setting b set reset f = let* _ = text b set in Lwt.finalize f (fun () -> Lwt.map ignore (text b reset)) (* [open_state kind b] opens a state of [kind] (data, service or persistent) for [b]: it is a URL that reads it, and its answers when the state is open and when it is closed. *) let open_state kind b = match kind with | "data" -> let+ _ = text b "/set?v=d" in "/get", "d", "" | "service" -> let+ url = text b "/coservice" in url, "coservice", "fallback" | "persistent" -> let+ _ = text b "/persistent/set?v=p" in "/persistent/get", "p", "" | k -> failwith ("unknown kind " ^ k) let kinds = ["data"; "service"; "persistent"] let timeouts server = let case = case_browsers server in let global_timeout kind = case ("global timeout of " ^ kind ^ " states") (fun browser -> let admin = browser () and b = browser () in let setting = "/global_timeout?kind=" ^ kind in with_setting admin (setting ^ "&t=1") setting (fun () -> let* url, opened, closed = open_state kind b in let* () = check "before" opened b url in let* () = sleep 1.5 in check "after" closed b url)) in (* The expiration dates of the open states follow a new global timeout only when they are recomputed. *) let recompute ?(recompute = true) kind = case (Printf.sprintf "expiration dates of %s states%s" kind (if recompute then ", recomputed" else "")) (fun browser -> let admin = browser () and b = browser () in let setting = "/global_timeout?kind=" ^ kind in with_setting admin (setting ^ "&t=10") setting (fun () -> let* url, opened, closed = open_state kind b in let* () = check "before" opened b url in let* _ = text admin (setting ^ "&t=1" ^ if recompute then "&recompute=on" else "") in let* () = sleep 1.5 in check "after" (if recompute then closed else opened) b url)) in ( "timeouts" , List.map global_timeout kinds @ List.map recompute kinds @ [ recompute ~recompute:false "data" ; case "timeout of a user first" (fun browser -> let admin = browser () and b = browser () and c = browser () in with_setting admin "/global_timeout?kind=data&t=1" "/global_timeout?kind=data" (fun () -> let* _ = text b "/set?v=b" in let* _ = text b "/timeout" in let* _ = text c "/set?v=c" in let* _ = text c "/timeout?t=5" in let* () = sleep 1.5 in let* () = check "no timeout" "b" b "/get" in check "longer timeout" "c" c "/get")) ; case "default timeout" (fun browser -> (* For all scope hierarchies *) let admin = browser () and b = browser () in with_setting admin "/default_timeout?kind=data&t=1" "/default_timeout?kind=data" (fun () -> let* _ = text b "/other/set?v=o" in let* () = check "before" "o" b "/other/get" in let* () = sleep 1.5 in check "after" "" b "/other/get")) ; case "default timeout of persistent states" (fun browser -> (* Of another hierarchy: the tests above set the global timeouts of the default hierarchy, which come first. *) let admin = browser () and b = browser () in with_setting admin "/default_timeout?kind=persistent&t=1" "/default_timeout?kind=persistent" (fun () -> let* _ = text b "/other/persistent/set?v=o" in let* () = check "before" "o" b "/other/persistent/get" in let* () = sleep 1.5 in check "after" "" b "/other/persistent/get")) ] ) let hierarchies server = let case = case_browsers server in ( "scope hierarchies" , [ case "independent" (fun browser -> let b = browser () in let* _ = text b "/set?v=a" in let* _ = text b "/other/set?v=o" in let* _ = text b "/discard?scope=session" in let* () = check "discarded" "" b "/get" in let* () = check "other hierarchy" "o" b "/other/get" in let* _ = text b "/discard?scope=other" in check "other hierarchy discarded" "" b "/other/get") ; case "discard all scopes" (fun browser -> let b = browser () in let* _ = text b "/set?v=a" in let* _ = text b "/other/set?v=o" in let* _ = text b "/group/join?name=all-g" in let* _ = text b "/group/set?v=g" in let* _ = text b "/discard_all_scopes" in let* () = check "session" "" b "/get" in let* () = check "other hierarchy" "" b "/other/get" in check "group" "" b "/group/get") ] ) let groups server = let case = case_browsers server in ( "groups" , [ case "leave a group" (fun browser -> let a = browser () and b = browser () in let* _ = text a "/group/join?name=leave-g" in let* _ = text b "/group/join?name=leave-g" in let* _ = text a "/group/set?v=g" in let* () = check "name" "leave-g" a "/group/name" in let* _ = text a "/group/leave" in let* () = check "no group" "none" a "/group/name" in (* Without a group, the data of the group scope are those of the session. *) let* () = check "group data" "" a "/group/get" in check "other member" "g" b "/group/get") ; case "list of groups" (fun browser -> let a = browser () and b = browser () in let* _ = text a "/group/join?name=list-a" in let* _ = text b "/group/join?name=list-b" in let+ groups = text a "/groups" in let groups = String.split_on_char ',' groups in Alcotest.(check (list bool)) "listed" [true; true] [List.mem "list-a" groups; List.mem "list-b" groups]) ] ) let without_group server = let case = case_browsers server in ( "without a group" , [ case "limit of sessions" (fun browser -> (* The sessions of the site that are not in a group count together. *) let a = browser () and b = browser () and c = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* _ = text c "/set?v=c" in let* () = check "number of sessions" "2" a "/count" in let* () = check "second" "b" b "/get" in let* () = check "newest" "c" c "/get" in (* Last: reading a session reference without value opens a session, which would close another one. *) check "oldest" "" a "/get") ; case "limit of the parent of a session" (fun browser -> (* A session without a group has no parent of its own: it cannot lower the limit of all the sessions without a group. *) let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* _ = text a "/max_in_parent?n=1" in let* () = check "number of sessions" "2" b "/count" in let* () = check "other session" "b" b "/get" in check "session of the request" "a" a "/get") ; case "limit not positive" (fun browser -> (* The function raises Invalid_argument, and the limit does not change. *) let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* () = check "rejected" "invalid" a "/max_without_group?n=0" in let* () = check "number of sessions" "2" b "/count" in let* () = check "newest" "b" b "/get" in check "oldest" "a" a "/get") ; case "new limit" (fun browser -> (* A new limit applies at once: the session used least recently is closed. *) let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in with_setting a "/max_without_group?n=1" "/max_without_group?n=2" (fun () -> let* () = check "number of sessions" "1" b "/count" in let* () = check "newest" "b" b "/get" in check "oldest, closed" "" a "/get")) ] ) let collection server = let case = case_browsers server in ( "collection" , [ case "expired sessions" (fun browser -> let a = browser () and b = browser () and c = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* _ = text c "/set?v=c" in let* () = check "open" "3" a "/count" in let* () = sleep 3. in (* Collected without being accessed *) check "collected" "0" a "/count") ] ) (* The limit of groups of the site, set by a member of a group that has states of one kind only: the group used least recently is closed. *) let limit_of_groups kind server = let case = case_browsers server in ( "limit of groups" , match kind with | `Service -> [ case "service states" (fun browser -> let a = browser () and b = browser () and c = browser () in let* url_a = text a "/service/join?name=ga" in let* _ = text a "/service/max_groups?n=2" in let* url_b = text b "/service/join?name=gb" in let* url_c = text c "/service/join?name=gc" in let* () = check "second" "coservice" b url_b in let* () = check "newest" "coservice" c url_c in check "oldest" "fallback" a url_a) ; case "service states, least recently used" (fun browser -> (* [a] uses its group after [b] creates its own: the group of [b] is closed. *) let a = browser () and b = browser () and c = browser () in let* url_a = text a "/service/join?name=ga2" in let* _ = text a "/service/max_groups?n=2" in let* url_b = text b "/service/join?name=gb2" in let* () = check "used" "coservice" a url_a in let* url_c = text c "/service/join?name=gc2" in let* () = check "kept" "coservice" a url_a in let* () = check "newest" "coservice" c url_c in check "least recently used" "fallback" b url_b) ] | `Data -> [ case "data states" (fun browser -> let a = browser () and b = browser () and c = browser () in let* _ = text a "/data/join?name=da&v=a" in let* _ = text a "/data/max_groups?n=2" in let* _ = text b "/data/join?name=db&v=b" in let* _ = text c "/data/join?name=dc&v=c" in let* () = check "second" "b" b "/get" in let* () = check "newest" "c" c "/get" in check "oldest" "" a "/get") ; case "data states, least recently used" (fun browser -> let a = browser () and b = browser () and c = browser () in let* _ = text a "/data/join?name=da2&v=a" in let* _ = text a "/data/max_groups?n=2" in let* _ = text b "/data/join?name=db2&v=b" in let* () = check "used" "a" a "/get" in let* _ = text c "/data/join?name=dc2&v=c" in let* () = check "kept" "a" a "/get" in let* () = check "newest" "c" c "/get" in (* Last: reading a session reference without value opens a session. *) check "least recently used" "" b "/get") ] ) (* The anonymous coservices of the global table created during requests are limited for the whole site; those created during the initialisation of the site are not counted, and stay. *) let anonymous_coservices server = let case = case_browsers server in ( "anonymous coservices" , [ case "limit of the site" (fun browser -> let a = browser () and b = browser () and c = browser () in let* initial = text a "/initial" in let* u1 = text a "/coservice?v=1" in let* u2 = text b "/coservice?v=2" in let* u3 = text c "/coservice?v=3" in let* () = check "initialisation" "initial" a initial in let* () = check "second" "coservice 2" a u2 in let* () = check "newest" "coservice 3" b u3 in check "oldest" "fallback" c u1) ] ) let run name exe suites = Server_harness.with_server exe (fun server -> Alcotest.run ~and_exit:false name (suites server)) let () = run "eliom-server-site-wide" "./timeouts_server.exe" (fun server -> [timeouts server; hierarchies server; groups server]); run "eliom-server-without-group" "./no_group_server.exe" (fun server -> [without_group server]); run "eliom-server-collection" "./gc_server.exe" (fun server -> [collection server]); run "eliom-server-groups-of-services" "./groups_server.exe" (fun server -> [limit_of_groups `Service server]); run "eliom-server-groups-of-data" "./groups_server.exe" (fun server -> [limit_of_groups `Data server]); run "eliom-server-anonymous-coservices" "./anonymous_server.exe" (fun server -> [anonymous_coservices server]) eliom-13.0.0/test/server/site_wide/timeouts_server.ml000066400000000000000000000115371527170563500227540ustar00rootroot00000000000000(* Global and default timeouts, scope hierarchies and session groups. The timeouts set by the services apply to the whole site. *) open Eliom open Eliom_test_services open Lwt.Syntax module P = Parameter module V = Reference.Volatile let session_scope = Common.default_session_scope let cookie_scope = (session_scope :> Common.cookie_scope) (* Global and default timeouts of the states of a kind (data, service or persistent), [None] without [t] *) let () = string (get ["global_timeout"] P.(string "kind" ** opt (float "t") ** bool "recompute")) (fun (kind, (t, recompute_expdates)) () -> let set = match kind with | "data" -> State.set_global_volatile_data_state_timeout | "service" -> State.set_global_service_state_timeout | "persistent" -> State.set_global_persistent_data_state_timeout | k -> failwith ("unknown kind " ^ k) in set ~cookie_scope ~recompute_expdates ~override_configfile:true t; text "set") let () = string (get ["default_timeout"] P.(string "kind" ** opt (float "t"))) (fun (kind, t) () -> let set = match kind with | "data" -> State.set_default_global_volatile_data_state_timeout | "service" -> State.set_default_global_service_state_timeout | "persistent" -> State.set_default_global_persistent_data_state_timeout | k -> failwith ("unknown kind " ^ k) in set ~cookie_level:`Session ~override_configfile:true t; text "set") (* A persistent session reference *) let persistent_value = Reference.eref ~scope:session_scope ~persistent:("test_site_wide_value", [%json: string]) "" let () = string (get ["persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set persistent_value v in text "set") let () = string (get ["persistent"; "get"] P.unit) (fun () () -> let* v = Reference.get persistent_value in text v) (* A coservice of the session, whose URL is the answer of /coservice *) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let () = string (get ["coservice"] P.unit) (fun () () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in Registration.String.register ~scope:session_scope ~service (fun () () -> text "coservice"); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) let () = string (get ["timeout"] P.(opt (float "t"))) (fun t () -> State.set_volatile_data_state_timeout ~cookie_scope t; text "set") (* A session reference of another scope hierarchy *) let other_scope = `Session (Common.create_scope_hierarchy "other") let other_value = V.eref ~scope:other_scope "" let () = string (get ["other"; "set"] P.(string "v")) (fun v () -> V.set other_value v; text "set") let () = string (get ["other"; "get"] P.unit) (fun () () -> text (V.get other_value)) let other_persistent_value = Reference.eref ~scope:other_scope ~persistent:("test_site_wide_other_value", [%json: string]) "" let () = string (get ["other"; "persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set other_persistent_value v in text "set") let () = string (get ["other"; "persistent"; "get"] P.unit) (fun () () -> let* v = Reference.get other_persistent_value in text v) let () = string (get ["discard"] P.(string "scope")) (fun scope () -> let* () = match scope with | "session" -> State.discard ~scope:session_scope () | "other" -> State.discard ~scope:other_scope () | s -> failwith ("unknown scope " ^ s) in text "discarded") let () = string (get ["discard_all_scopes"] P.unit) (fun () () -> let* () = State.discard_all_scopes () in text "discarded") (* Session groups *) let group_value = V.eref ~scope:Common.default_group_scope "" let () = string (get ["group"; "join"] P.(string "name")) (fun name () -> State.set_volatile_data_session_group ~scope:session_scope name; text "joined") let () = string (get ["group"; "leave"] P.unit) (fun () () -> State.unset_volatile_data_session_group ~scope:session_scope (); text "left") let () = string (get ["group"; "name"] P.unit) (fun () () -> text (Option.value ~default:"none" (State.get_volatile_data_session_group ~scope:session_scope ()))) let () = string (get ["group"; "set"] P.(string "v")) (fun v () -> V.set group_value v; text "set") let () = string (get ["group"; "get"] P.unit) (fun () () -> text (V.get group_value)) let () = string (get ["groups"] P.unit) (fun () () -> text (String.concat "," (List.sort compare (State.Ext.get_session_group_list ())))) let () = Services.start () eliom-13.0.0/test/server/state/000077500000000000000000000000001527170563500163205ustar00rootroot00000000000000eliom-13.0.0/test/server/state/dune000066400000000000000000000004671527170563500172050ustar00rootroot00000000000000(executable (name server) (modules server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite cohttp eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server alcotest)) eliom-13.0.0/test/server/state/server.ml000066400000000000000000000172061527170563500201660ustar00rootroot00000000000000(* The test server of test.ml: services that set, read and discard the states of the browser sending the request, and answer in plain text. *) open Eliom open Eliom_test_services module P = Parameter module V = Reference.Volatile open Lwt.Syntax let session_scope = Common.default_session_scope let group_scope = Common.default_group_scope (* Session data *) let session_value = V.eref ~scope:session_scope "" let () = string (get ["set"] P.(string "v")) (fun v () -> V.set session_value v; text "set") let () = string (get ["get"] P.unit) (fun () () -> text (V.get session_value)) let string_of_status = function | State.Alive_state -> "alive" | State.Empty_state -> "empty" | State.Expired_state -> "expired" let () = string (get ["status"] P.unit) (fun () () -> text (Printf.sprintf "data=%s services=%s" (string_of_status (State.volatile_data_state_status ~scope:session_scope ())) (string_of_status (State.service_state_status ~scope:session_scope ())))) (* Session services: a coservice registered for the session of the request, whose fallback answers for the other browsers *) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let () = string (get ["coservice"] P.unit) (fun () () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in let owner = V.get session_value in Registration.String.register ~scope:session_scope ~service (fun () () -> text ("coservice of " ^ owner)); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) (* Closing *) let scope_of_string = function | "session" -> (session_scope :> Common.user_scope) | "group" -> (group_scope :> Common.user_scope) | s -> failwith ("unknown scope " ^ s) let () = string (get ["discard"] P.(string "scope")) (fun scope () -> let* () = State.discard ~scope:(scope_of_string scope) () in text "discarded") let () = string (get ["discard_data"] P.(string "scope")) (fun scope () -> let* () = State.discard_data ~scope:(scope_of_string scope) () in text "data discarded") let () = string (get ["discard_services"] P.(string "scope")) (fun scope () -> State.discard_services ~scope:(scope_of_string scope) (); text "services discarded") (* Persistent session data *) let persistent_value = Reference.eref ~scope:session_scope ~persistent:("test_session_value", [%json: string]) "" let () = string (get ["persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set persistent_value v in text "set") let () = string (get ["persistent"; "get"] P.unit) (fun () () -> let* v = Reference.get persistent_value in text v) (* Session groups *) let group_value = V.eref ~scope:group_scope "" let () = string (get ["group"; "join"] P.(string "name" ** opt (int "max"))) (fun (name, set_max) () -> State.set_volatile_data_session_group ?set_max ~scope:session_scope name; State.set_service_session_group ?set_max ~scope:session_scope name; let* () = State.set_persistent_data_session_group ?set_max:(Option.map Option.some set_max) ~scope:session_scope name in text "joined") let () = string (get ["group"; "set"] P.(string "v")) (fun v () -> V.set group_value v; text "set") let () = string (get ["group"; "get"] P.unit) (fun () () -> text (V.get group_value)) let persistent_group_value = Reference.eref ~scope:group_scope ~persistent:("test_group_value", [%json: string]) "" let () = string (get ["group"; "persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set persistent_group_value v in text "set") let () = string (get ["group"; "persistent"; "get"] P.unit) (fun () () -> let* v = Reference.get persistent_group_value in text v) let () = string (get ["group"; "size"] P.unit) (fun () () -> text (match State.get_volatile_data_session_group_size ~scope:session_scope () with | Some n -> string_of_int n | None -> "none")) (* The sessions of a group, from outside the group, as Os.Session.disconnect_all of Ocsigen Start closes them *) let () = string (get ["group"; "sessions"] P.(string "name")) (fun name () -> let state = State.Ext.volatile_data_group_state ~scope:group_scope name in text (string_of_int (State.Ext.fold_volatile_sub_states ~state (fun n _ -> n + 1) 0))) let () = string (get ["group"; "persistent_sessions"] P.(string "name")) (fun name () -> let state = State.Ext.persistent_data_group_state ~scope:group_scope name in let* n = State.Ext.fold_sub_states ~state (fun n _ -> Lwt.return (n + 1)) 0 in text (string_of_int n)) (* The persistent session group of the browser *) let () = string (get ["group"; "persistent"; "name"] P.unit) (fun () () -> let+ g = State.get_persistent_data_session_group ~scope:session_scope () in Option.value g ~default:"none", "text/plain") let () = string (get ["group"; "persistent"; "leave"] P.unit) (fun () () -> let* () = State.unset_persistent_data_session_group ~scope:session_scope () in text "left") (* A slow request of the persistent session of the browser *) let () = string (get ["persistent"; "slow"] P.(float "t")) (fun t () -> (* The group read at the beginning of the request *) let* g = State.get_persistent_data_session_group ~scope:session_scope () in let* () = Lwt_unix.sleep t in text (Option.value g ~default:"none")) (* A non-attached coservice registered for the session group of the browser *) let () = string (get ["group"; "nacoservice"] P.unit) (fun () () -> let service = Service.create ~path:Service.No_path ~meth:(Service.Get P.unit) () in let owner = V.get session_value in Registration.String.register ~scope:group_scope ~service (fun () () -> text ("group nacoservice of " ^ owner)); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) (* The timeout of the persistent session of the browser, in seconds *) let () = string (get ["persistent"; "timeout"] P.(float "t")) (fun t () -> let* () = State.set_persistent_data_state_timeout ~cookie_scope:session_scope (Some t) in text "set") let () = string (get ["group"; "close_sessions"] P.(string "name")) (fun name () -> let close state = State.Ext.iter_sub_states ~state (fun state -> State.Ext.discard_state ~state ()) in let* () = close (State.Ext.volatile_data_group_state ~scope:group_scope name) in let* () = close (State.Ext.service_group_state ~scope:group_scope name) in let* () = close (State.Ext.persistent_data_group_state ~scope:group_scope name) in text "closed") (* A coservice registered for the session group of the browser *) let () = string (get ["group"; "coservice"] P.unit) (fun () () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in let owner = V.get session_value in Registration.String.register ~scope:group_scope ~service (fun () () -> text ("group coservice of " ^ owner)); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/state/test.ml000066400000000000000000000511421527170563500176340ustar00rootroot00000000000000(* Tests of the states of browsers: each simulated browser has its own cookies, hence its own sessions. *) open Eliom_test_server open Helpers open Lwt.Syntax let cookie_header cookies = "cookie", String.concat "; " (List.map (fun (n, v) -> n ^ "=" ^ v) cookies) (* [check_replay msg expected cookies b url] checks the body of the response to [url] for [b] sending [cookies] instead of its own: a closed state must be gone on the server, not only forgotten by the browser. *) let check_replay msg expected cookies b url = let+ r = Browser.get ~headers:[cookie_header cookies] b url in Alcotest.(check string) (msg ^ " (old cookies)") expected r.body let isolation server = let case = case_browsers server in ( "isolation" , [ case "session data" (fun browser -> let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* () = check "own value" "a" a "/get" in let* () = check "other browser" "" b "/get" in let* _ = text b "/set?v=b" in check "unchanged by the other browser" "a" a "/get") ; case "persistent data" (fun browser -> let a = browser () and b = browser () in let* _ = text a "/persistent/set?v=a" in let* () = check "own value" "a" a "/persistent/get" in check "other browser" "" b "/persistent/get") ; case "status" (fun browser -> let a = browser () in let* () = check "new browser" "data=empty services=empty" a "/status" in let* _ = text a "/set?v=a" in check "with data" "data=alive services=empty" a "/status") ; case "session coservice" (fun browser -> let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* url = text a "/coservice" in let* () = check "owner" "coservice of a" a url in let* () = check "services" "data=alive services=alive" a "/status" in check "other browser" "fallback" b url) ; case "cookie" (fun browser -> (* A session is its cookie: whoever sends it gets the session. *) let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let+ r = Browser.get ~headers:[cookie_header (Browser.cookies a)] b "/get" in Alcotest.(check string) "value of the cookie" "a" r.body) ] ) let closing server = let case = case_browsers server in ( "closing" , [ case "discard the session" (fun browser -> let a = browser () in let* _ = text a "/set?v=a" in let* _ = text a "/persistent/set?v=a" in let* url = text a "/coservice" in let old_cookies = Browser.cookies a in let* _ = text a "/discard?scope=session" in Alcotest.(check (list (pair string string))) "cookies removed" [] (Browser.cookies a); let* () = check "status" "data=empty services=empty" a "/status" in let* () = check "persistent data" "" a "/persistent/get" in let* () = check "data" "" a "/get" in let* () = check "services" "fallback" a url in let c = browser () in let* () = check_replay "data" "" old_cookies c "/get" in let* () = check_replay "persistent data" "" old_cookies c "/persistent/get" in check_replay "services" "fallback" old_cookies c url) ; case "discard the data only" (fun browser -> let a = browser () in let* _ = text a "/set?v=a" in let* url = text a "/coservice" in let* _ = text a "/discard_data?scope=session" in let* () = check "data" "" a "/get" in check "services kept" "coservice of a" a url) ; case "discard the services only" (fun browser -> let a = browser () in let* _ = text a "/set?v=a" in let* url = text a "/coservice" in let* _ = text a "/discard_services?scope=session" in let* () = check "services" "fallback" a url in check "data kept" "a" a "/get") ; case "other sessions" (fun browser -> let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* url = text b "/coservice" in let* _ = text a "/discard?scope=session" in let* () = check "data of the other browser" "b" b "/get" in check "services of the other browser" "coservice of b" b url) ] ) (* Each test uses groups of its own, since the server is shared. *) let groups server = let case = case_browsers server in let join b ?max name = text b ("/group/join?name=" ^ name ^ match max with Some m -> "&max=" ^ string_of_int m | None -> "") in ( "groups" , [ case "group data" (fun browser -> let a = browser () and b = browser () and c = browser () in let* _ = join a "data-g" in let* _ = join b "data-g" in let* _ = join c "data-h" in let* _ = text a "/group/set?v=g" in let* _ = text a "/set?v=a" in let* () = check "same group" "g" b "/group/get" in let* () = check "other group" "" c "/group/get" in let* () = check "session data stays private" "" b "/get" in check "size" "2" a "/group/size") ; case "discard a group" (fun browser -> let a = browser () and b = browser () and c = browser () in let* _ = join a "discard-g" in let* _ = join b "discard-g" in let* _ = join c "discard-h" in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* _ = text c "/set?v=c" in let* url = text b "/coservice" in let* _ = text a "/group/set?v=g" in let* _ = text b "/persistent/set?v=b" in let* _ = text a "/group/persistent/set?v=g" in let* _ = text a "/discard?scope=group" in (* Closing a group closes all its sessions. *) let* () = check "session of the browser" "" a "/get" in let* () = check "session of the other member" "" b "/get" in let* () = check "services of the other member" "fallback" b url in let* () = check "group data" "" b "/group/get" in let* () = check "persistent data of the other member" "" b "/persistent/get" in let* () = check "persistent group data" "" b "/group/persistent/get" in check "other group" "c" c "/get") ; case "discard a group without a named group" (fun browser -> (* Without a session group, a session is counted with the sessions without a group of the site, which belong to other users: only the session is closed. *) let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text a "/persistent/set?v=a" in let* url_a = text a "/coservice" in let* _ = text b "/set?v=b" in let* _ = text b "/persistent/set?v=b" in let* url_b = text b "/coservice" in let old_cookies = Browser.cookies a in let* _ = text a "/discard?scope=group" in let* () = check "data" "" a "/get" in let* () = check "persistent data" "" a "/persistent/get" in let* () = check "services" "fallback" a url_a in let* () = check "data of the other browser" "b" b "/get" in let* () = check "persistent data of the other browser" "b" b "/persistent/get" in let* () = check "services of the other browser" "coservice of b" b url_b in let c = browser () in let* () = check_replay "data" "" old_cookies c "/get" in let* () = check_replay "persistent data" "" old_cookies c "/persistent/get" in check_replay "services" "fallback" old_cookies c url_a) ; case "limit" (fun browser -> let a = browser () and b = browser () and c = browser () in let* _ = text a "/set?v=a" in let* _ = join a ~max:2 "limit-g" in let* _ = text b "/set?v=b" in let* _ = join b ~max:2 "limit-g" in let* _ = text c "/set?v=c" in let* _ = join c ~max:2 "limit-g" in (* The oldest session of the group is closed. *) let* () = check "oldest" "" a "/get" in let* () = check "second" "b" b "/get" in let* () = check "newest" "c" c "/get" in check "size" "2" c "/group/size") ; case "limit, services and persistent data" (fun browser -> let a = browser () and b = browser () and c = browser () in let open_states b v = let* _ = text b ("/set?v=" ^ v) in let* url = text b "/coservice" in let* _ = text b ("/persistent/set?v=" ^ v) in let+ _ = join b ~max:2 "limit-sp" in url in let* url_a = open_states a "a" in let* url_b = open_states b "b" in let* url_c = open_states c "c" in (* The oldest session of the group is closed. *) let* () = check "services, oldest" "fallback" a url_a in let* () = check "services, second" "coservice of b" b url_b in let* () = check "services, newest" "coservice of c" c url_c in let* () = check "persistent, oldest" "" a "/persistent/get" in let* () = check "persistent, second" "b" b "/persistent/get" in check "persistent, newest" "c" c "/persistent/get") ; case "limit, least recently used" (fun browser -> (* The session closed is the one used least recently, not the oldest one: [a] is used after [b] joins, so [b] is closed. *) let a = browser () and b = browser () and c = browser () in let open_states b v = let* _ = text b ("/set?v=" ^ v) in let* url = text b "/coservice" in let* _ = text b ("/persistent/set?v=" ^ v) in let+ _ = join b ~max:2 "limit-lru" in url in let* url_a = open_states a "a" in let* url_b = open_states b "b" in let* () = check "data, used" "a" a "/get" in let* () = check "services, used" "coservice of a" a url_a in let* () = check "persistent, used" "a" a "/persistent/get" in let* url_c = open_states c "c" in let* () = check "data, kept" "a" a "/get" in let* () = check "services, kept" "coservice of a" a url_a in let* () = check "persistent, kept" "a" a "/persistent/get" in let* () = check "data, newest" "c" c "/get" in let* () = check "services, newest" "coservice of c" c url_c in let* () = check "persistent, newest" "c" c "/persistent/get" in (* Last: reading a session reference without value opens a session. *) let* () = check "services, closed" "fallback" b url_b in let* () = check "persistent, closed" "" b "/persistent/get" in check "data, closed" "" b "/get") ; case "limit, simultaneous logins" (fun browser -> (* Browsers join a full group at the same time: the group keeps exactly its maximum number of sessions, and the other ones are closed. A session lost from the list of a persistent group would neither count nor be closed. *) let admin = browser () in let browsers = List.init 8 (fun _ -> browser ()) in let* () = Lwt_list.iteri_s (fun i b -> let v = string_of_int i in let* _ = text b ("/set?v=" ^ v) in Lwt.map ignore (text b ("/persistent/set?v=" ^ v))) browsers in let* () = Lwt_list.iter_p (fun b -> Lwt.map ignore (join b ~max:3 "limit-simultaneous")) browsers in let alive url = Lwt_list.fold_left_s (fun n b -> let+ v = text b url in if v = "" then n else n + 1) 0 browsers in let* () = check "persistent sessions of the group" "3" admin "/group/persistent_sessions?name=limit-simultaneous" in let* () = check "volatile sessions of the group" "3" admin "/group/sessions?name=limit-simultaneous" in let* n = alive "/persistent/get" in Alcotest.(check int) "persistent sessions alive" 3 n; let+ n = alive "/get" in Alcotest.(check int) "data sessions alive" 3 n) ; case "limit, simultaneous logins of new browsers" (fun browser -> (* Same, with browsers that have no session yet: each request opens a persistent session in the group, which a request of another browser may close before the end of the first request. The end of the request must not write that session back. *) let admin = browser () in let browsers = List.init 8 (fun _ -> browser ()) in let* () = Lwt_list.iter_p (fun b -> Lwt.map ignore (join b ~max:3 "limit-new")) browsers in let* () = check "persistent sessions of the group" "3" admin "/group/persistent_sessions?name=limit-new" in let+ n = Lwt_list.fold_left_s (fun n b -> let+ v = text b "/group/persistent/name" in if v = "limit-new" then n + 1 else n) 0 browsers in Alcotest.(check int) "persistent sessions in the group" 3 n) ; case "simultaneous logins of a session" (fun browser -> (* Two requests of a session join the group at the same time (a double click, for instance): the session is listed once. *) let admin = browser () and a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = Lwt.both (join a "twice-g") (join a "twice-g") in check "persistent sessions of the group" "1" admin "/group/persistent_sessions?name=twice-g") ; case "simultaneous logins of a session, limit of one" (fun browser -> (* As "simultaneous logins of a session", in a group of one session: a second place of the session in the list would go over the limit, and close the session. *) let a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = Lwt.both (join a ~max:1 "twice-one") (join a ~max:1 "twice-one") in let* () = check "persistent data" "a" a "/persistent/get" in check "group" "twice-one" a "/group/persistent/name") ; case "group changed by another request" (fun browser -> (* The end of a request writes back the persistent session group only if the request changed it: here a slow request of the session ends after another one has taken the session out of its group. *) let admin = browser () and a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = join a "changed-g" in (* A short timeout, and a pause: the expiration date, computed from the beginning of the slow request, moves enough to be written at its end. *) let* _ = text a "/persistent/timeout?t=30" in let* () = Lwt_unix.sleep 1. in let slow = text a "/persistent/slow?t=1" in let* () = Lwt_unix.sleep 0.3 in let* _ = text a "/group/persistent/leave" in let* v = slow in (* The slow request has read the group before it was left *) Alcotest.(check string) "group read by the slow request" "changed-g" v; let* () = check "group" "none" a "/group/persistent/name" in check "sessions of the group" "0" admin "/group/persistent_sessions?name=changed-g") ; case "group coservice without a group" (fun browser -> (* Without a session group, the session is its own group: a service of the group scope is not visible to the other sessions without a group. *) let a = browser () and b = browser () in let* _ = text a "/set?v=a" in let* _ = text b "/set?v=b" in let* url = text a "/group/coservice" in let* () = check "own" "group coservice of a" a url in check "other session without a group" "fallback" b url) ; case "group coservices" (fun browser -> (* The services of the group scope are found for the sessions of the group, and only for them *) let a = browser () and b = browser () and c = browser () in let d = browser () in let* _ = text a "/set?v=a" in let* _ = join a "coservices-g" in let* _ = text b "/set?v=b" in let* _ = join b "coservices-g" in let* _ = text c "/set?v=c" in let* _ = join c "coservices-h" in let* _ = text d "/set?v=d" in let* url = text a "/group/coservice" in let* na = text a "/group/nacoservice" in (* A link to a non-attached coservice is on the current page: on /fallback, the sessions that do not find it get the fallback *) let na = let i = String.index na '?' in "/fallback" ^ String.sub na i (String.length na - i) in let* () = check "owner" "group coservice of a" a url in let* () = check "other member" "group coservice of a" b url in let* () = check "other group" "fallback" c url in let* () = check "no group" "fallback" d url in let* () = check "non-attached, owner" "group nacoservice of a" a na in let* () = check "non-attached, other member" "group nacoservice of a" b na in let* () = check "non-attached, other group" "fallback" c na in check "non-attached, no group" "fallback" d na) ; case "expired session" (fun browser -> (* A persistent session that has expired leaves its group when it is used again, and does not count in the group any more. *) let admin = browser () and a = browser () and b = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = join a "expired-g" in let* _ = text b "/persistent/set?v=b" in let* _ = join b "expired-g" in let* _ = text a "/persistent/timeout?t=1" in let* () = check "before" "2" admin "/group/persistent_sessions?name=expired-g" in let* () = Lwt_unix.sleep 2. in let* () = check "expired" "" a "/persistent/get" in let* () = check "other member" "b" b "/persistent/get" in check "after" "1" admin "/group/persistent_sessions?name=expired-g") ; case "close the sessions of a group" (fun browser -> (* From outside the group, as Os.Session.disconnect_all does *) let admin = browser () and a = browser () and b = browser () in let c = browser () in let open_states b ?(group = "sessions-g") v = let* _ = text b ("/set?v=" ^ v) in let* url = text b "/coservice" in let* _ = text b ("/persistent/set?v=" ^ v) in let+ _ = join b group in url in let* url_a = open_states a "a" in let* _ = open_states b "b" in let* url_c = open_states c ~group:"sessions-h" "c" in let* () = check "sessions" "2" admin "/group/sessions?name=sessions-g" in let* _ = text admin "/group/close_sessions?name=sessions-g" in let* () = check "closed" "0" admin "/group/sessions?name=sessions-g" in let* () = check "other group" "c" c "/get" in let* () = check "other group, services" "coservice of c" c url_c in let* () = check "other group, persistent" "c" c "/persistent/get" in let* () = check "services" "fallback" a url_a in let* () = check "persistent" "" a "/persistent/get" in let* () = check "data" "" a "/get" in check "other member" "" b "/get") ; case "simultaneous requests" (fun browser -> (* The sessions of a persistent group are listed in one entry of the database, which each request that opens or uses a session of the group reads and writes back. Two simultaneous requests must not lose each other's change: here pairs of browsers join the group at the same time, and every session must be closed with the group. *) let admin = browser () and a = browser () in let* _ = text a "/persistent/set?v=a" in let* _ = join a "simultaneous-g" in let* members = Lwt_list.map_s (fun _ -> let b = browser () and c = browser () in let* _ = text b "/persistent/set?v=b" in let* _ = text c "/persistent/set?v=c" in let+ _ = Lwt.both (join b "simultaneous-g") (join c "simultaneous-g") in [b; c]) (List.init 5 Fun.id) in let* _ = text admin "/group/close_sessions?name=simultaneous-g" in Lwt_list.iter_s (fun b -> check "closed" "" b "/persistent/get") (a :: List.concat members)) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-state" [isolation server; closing server; groups server]) eliom-13.0.0/test/server/tabs/000077500000000000000000000000001527170563500161315ustar00rootroot00000000000000eliom-13.0.0/test/server/tabs/dune000066400000000000000000000005521527170563500170110ustar00rootroot00000000000000(executable (name server) (modules server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom.server ocsipersist-sqlite eliom_test_server eliom_test_client alcotest)) eliom-13.0.0/test/server/tabs/server.ml000066400000000000000000000066011527170563500177740ustar00rootroot00000000000000(* The test server of test.ml: services that set, read and discard the states of the tab (client process) and of the browser session of the request, and answer in plain text. *) open Eliom open Eliom_test_services open Lwt.Syntax module P = Parameter module V = Reference.Volatile let tab_scope = Common.default_process_scope let session_scope = Common.default_session_scope let group_scope = Common.default_group_scope let tab_value = V.eref ~scope:tab_scope "" let session_value = V.eref ~scope:session_scope "" let () = string (get ["tab"; "set"] P.(string "v")) (fun v () -> V.set tab_value v; text "set") let () = string (get ["tab"; "get"] P.unit) (fun () () -> text (V.get tab_value)) let persistent_tab_value = Reference.eref ~scope:tab_scope ~persistent:("test_tab_value", [%json: string]) "" let () = string (get ["tab"; "persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set persistent_tab_value v in text "set") let () = string (get ["tab"; "persistent"; "get"] P.unit) (fun () () -> let* v = Reference.get persistent_tab_value in text v) let () = string (get ["session"; "set"] P.(string "v")) (fun v () -> V.set session_value v; text "set") let () = string (get ["session"; "get"] P.unit) (fun () () -> text (V.get session_value)) (* A coservice registered for the tab of the request *) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") let () = string (get ["tab"; "coservice"] P.unit) (fun () () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in Registration.String.register ~scope:tab_scope ~service (fun () () -> text "coservice of the tab"); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) (* A coservice registered for the group of the request *) let () = string (get ["group"; "coservice"] P.unit) (fun () () -> let service = Service.create_attached_get ~fallback ~get_params:P.unit () in Registration.String.register ~scope:group_scope ~service (fun () () -> text "coservice of the group"); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ())) (* The maximum number of tabs of the browser session of the request *) let () = string (get ["tab"; "max"] P.(int "n")) (fun n () -> State.set_max_volatile_states_in_parent ~scope:(tab_scope :> Common.user_scope) n; text "set") let () = string (get ["group"; "join"] P.(string "name")) (fun name () -> State.set_volatile_data_session_group ~scope:session_scope name; State.set_service_session_group ~scope:session_scope name; text "joined") let () = string (get ["group"; "leave_services"] P.unit) (fun () () -> State.unset_service_session_group ~scope:session_scope (); text "left") let scope_of_string = function | "tab" -> (tab_scope :> Common.user_scope) | "session" -> (session_scope :> Common.user_scope) | "group" -> (group_scope :> Common.user_scope) | s -> failwith ("unknown scope " ^ s) let () = string (get ["discard"] P.(string "scope")) (fun scope () -> let* () = State.discard ~scope:(scope_of_string scope) () in text "discarded") let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/tabs/test.ml000066400000000000000000000156741527170563500174570ustar00rootroot00000000000000(* Tests of the states of tabs (client processes): the tabs of a browser share its cookies, and each has its own tab cookies, which a client-side program sends in a header. *) open Eliom_test_server open Helpers open Lwt.Syntax let tab = Eliom_test_client.Tab.create let text tab url = let+ r = Eliom_test_client.Tab.get tab url in if r.status <> 200 then Alcotest.failf "%s: status %d" url r.status; r.body let check msg expected tab url = let+ body = text tab url in Alcotest.(check string) msg expected body let tabs server = let case = case_browsers server in ( "tabs" , [ case "tab data" (fun browser -> let b = browser () in let t1 = tab b and t2 = tab b in let* _ = text t1 "/tab/set?v=1" in let* _ = text t1 "/session/set?v=s" in let* () = check "own tab" "1" t1 "/tab/get" in let* () = check "other tab" "" t2 "/tab/get" in check "session shared by the tabs" "s" t2 "/session/get") ; case "tab coservice" (fun browser -> let b = browser () in let t1 = tab b and t2 = tab b in let* url = text t1 "/tab/coservice" in let* () = check "own tab" "coservice of the tab" t1 url in check "other tab" "fallback" t2 url) ; case "leave a group of services" (fun browser -> (* The service session of the browser has no service, but it is not closed, as a tab has one. *) let t = tab (browser ()) in let* _ = text t "/group/join?name=leave-g" in let* url = text t "/tab/coservice" in let* _ = text t "/group/leave_services" in check "tab coservice" "coservice of the tab" t url) ; case "tab cookies" (fun browser -> (* A tab is its tab cookies, as a session is its cookie: whoever sends them gets the tab, even from another browser. *) let t1 = tab (browser ()) and t2 = tab (browser ()) in let* _ = text t1 "/tab/set?v=1" in Eliom_test_client.Tab.set_tab_cookies t2 (Eliom_test_client.Tab.tab_cookies t1); check "value of the tab cookies" "1" t2 "/tab/get") ] ) let closing server = let case = case_browsers server in ( "closing" , [ case "close a tab" (fun browser -> let b = browser () in let t1 = tab b and t2 = tab b in let* _ = text t1 "/tab/set?v=1" in let* _ = text t2 "/tab/set?v=2" in let* _ = text t1 "/session/set?v=s" in let* _ = text t1 "/discard?scope=tab" in let* () = check "closed tab" "" t1 "/tab/get" in let* () = check "other tab" "2" t2 "/tab/get" in check "session" "s" t2 "/session/get") ; case "close the session" (fun browser -> (* Closing a browser session closes its tabs. *) let b = browser () in let t1 = tab b and t2 = tab b in let* _ = text t1 "/session/set?v=s" in let* _ = text t1 "/tab/set?v=1" in let* _ = text t2 "/tab/set?v=2" in let* url = text t2 "/tab/coservice" in let* _ = text t1 "/discard?scope=session" in let* () = check "session" "" t2 "/session/get" in let* () = check "tab of the request" "" t1 "/tab/get" in let* () = check "other tab" "" t2 "/tab/get" in check "coservice of the other tab" "fallback" t2 url) ; case "close the group" (fun browser -> (* Closing a group closes the tabs of its sessions. *) let a = tab (browser ()) and b = tab (browser ()) in let* _ = text a "/group/join?name=tabs-g" in let* _ = text b "/group/join?name=tabs-g" in let* _ = text b "/tab/set?v=b" in let* _ = text a "/discard?scope=group" in check "tab of another session of the group" "" b "/tab/get") ; case "close the last tab of a session in a group" (fun browser -> (* The service session of the browser has no service of its own, but it is in a group: it is kept, and so are the services of the group. The coservice of the tab gives the tab a service session, so that there is a last tab service session to close. *) let t = tab (browser ()) in let* _ = text t "/group/join?name=last-tab-g" in let* _ = text t "/tab/coservice" in let* url = text t "/group/coservice" in let* _ = text t "/discard?scope=tab" in check "group coservice" "coservice of the group" t url) ] ) let limits server = let case = case_browsers server in ( "limits" , [ case "least recently used tab" (fun browser -> (* Beyond the limit, the tab used least recently is closed: [t1] is used after [t2] is opened, so [t2] is closed. *) let b = browser () in let t1 = tab b and t2 = tab b and t3 = tab b in let* _ = text t1 "/tab/set?v=1" in let* url1 = text t1 "/tab/coservice" in let* _ = text t1 "/tab/max?n=2" in let* _ = text t2 "/tab/set?v=2" in let* url2 = text t2 "/tab/coservice" in let* () = check "used" "1" t1 "/tab/get" in let* _ = text t3 "/tab/set?v=3" in let* _ = text t3 "/tab/coservice" in let* () = check "kept" "1" t1 "/tab/get" in let* () = check "kept, coservice" "coservice of the tab" t1 url1 in let* () = check "newest" "3" t3 "/tab/get" in let* () = check "closed, coservice" "fallback" t2 url2 in (* Last: reading a tab reference without value opens a tab session. *) check "closed" "" t2 "/tab/get") ; case "default limit of tabs" (fun browser -> (* A browser session holds 100 tab sessions by default *) let b = browser () in let tabs = List.init 101 (fun _ -> tab b) in let* () = Lwt_list.iteri_s (fun i t -> Lwt.map ignore (text t ("/tab/set?v=" ^ string_of_int i))) tabs in match tabs with | first :: second :: _ -> let* () = check "second" "1" second "/tab/get" in let* () = check "last" "100" (List.nth tabs 100) "/tab/get" in check "first, closed" "" first "/tab/get" | _ -> Alcotest.fail "not enough tabs") ; case "default limit of persistent tabs" (fun browser -> (* The limit of tabs applies to persistent tab sessions too *) let b = browser () in let tabs = List.init 101 (fun _ -> tab b) in let* () = Lwt_list.iteri_s (fun i t -> Lwt.map ignore (text t ("/tab/persistent/set?v=" ^ string_of_int i))) tabs in match tabs with | first :: second :: _ -> let* () = check "second" "1" second "/tab/persistent/get" in let* () = check "last" "100" (List.nth tabs 100) "/tab/persistent/get" in check "first, closed" "" first "/tab/persistent/get" | _ -> Alcotest.fail "not enough tabs") ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-tabs" [tabs server; closing server; limits server]) eliom-13.0.0/test/server/timeouts/000077500000000000000000000000001527170563500170515ustar00rootroot00000000000000eliom-13.0.0/test/server/timeouts/dune000066400000000000000000000005071527170563500177310ustar00rootroot00000000000000(executable (name server) (modules server) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite cohttp eliom_test_server eliom_test_services)) (test (name test) (modules test) (package eliom) (deps server.exe) (libraries eliom_test_server cohttp lwt.unix alcotest)) eliom-13.0.0/test/server/timeouts/server.ml000066400000000000000000000053271527170563500207200ustar00rootroot00000000000000(* The test server of test.ml: services that set the timeouts of the states of the browser sending the request, and answer in plain text. *) open Eliom open Eliom_test_services open Lwt.Syntax module P = Parameter module V = Reference.Volatile let session_scope = Common.default_session_scope let cookie_scope = (session_scope :> Common.cookie_scope) (* States *) let value = V.eref ~scope:session_scope "" let persistent_value = Reference.eref ~scope:session_scope ~persistent:("test_timeouts_value", [%json: string]) "" let () = string (get ["set"] P.(string "v")) (fun v () -> V.set value v; text "set") let () = string (get ["get"] P.unit) (fun () () -> text (V.get value)) let () = string (get ["persistent"; "set"] P.(string "v")) (fun v () -> let* () = Reference.set persistent_value v in text "set") let () = string (get ["persistent"; "get"] P.unit) (fun () () -> let* v = Reference.get persistent_value in text v) let fallback = get ["fallback"] P.unit let () = string fallback (fun () () -> text "fallback") (* [coservice ?timeout ?max_use ()] is the URL of a new coservice of the session of the request. *) let coservice ?timeout ?max_use () = let service = Service.create_attached_get ?timeout ?max_use ~fallback ~get_params:P.unit () in Registration.String.register ~scope:session_scope ~service (fun () () -> text "coservice"); text (Eliom_uri.make_string_uri ~absolute_path:true ~service ()) let () = string (get ["coservice"] P.unit) (fun () () -> coservice ()) let () = string (get ["timed_coservice"] P.(float "t")) (fun timeout () -> coservice ~timeout ()) let () = string (get ["counted_coservice"] P.(int "n")) (fun max_use () -> coservice ~max_use ()) (* Timeouts of the states of the session, [None] without [t] *) let () = string (get ["timeout"] P.(string "kind" ** opt (float "t"))) (fun (kind, t) () -> let* () = match kind with | "data" -> State.set_volatile_data_state_timeout ~cookie_scope t; Lwt.return_unit | "service" -> State.set_service_state_timeout ~cookie_scope t; Lwt.return_unit | "persistent" -> State.set_persistent_data_state_timeout ~cookie_scope t | k -> failwith ("unknown kind " ^ k) in text "timeout set") (* Expiration dates of the cookies, [t] seconds from now *) let () = string (get ["cookie_expiration"] P.(opt (float "t"))) (fun t () -> State.set_volatile_data_cookie_exp_date ~cookie_scope (Option.map (fun t -> Unix.time () +. t) t); text "expiration set") let () = Eliom_test_server.Server_harness.start [App.run ()] eliom-13.0.0/test/server/timeouts/test.ml000066400000000000000000000112221527170563500203600ustar00rootroot00000000000000(* Tests of the timeouts of states, coservices and cookies, and of persistent data across a restart of the server. Expiry is checked when a state is accessed, so timeouts of 1 s are enough. *) open Eliom_test_server open Helpers open Lwt.Syntax let sleep = Lwt_unix.sleep let states server = let case = case server in ( "states" , [ case "data" (fun b -> let* _ = text b "/set?v=a" in let* _ = text b "/timeout?kind=data&t=1" in let* () = check "before" "a" b "/get" in let* () = sleep 1.5 in check "after" "" b "/get") ; case "access extends the timeout" (fun b -> let* _ = text b "/set?v=a" in let* _ = text b "/timeout?kind=data&t=1" in let rec access n = if n = 0 then Lwt.return_unit else let* () = sleep 0.5 in let* () = check "within the timeout" "a" b "/get" in access (n - 1) in let* () = access 4 in let* () = sleep 1.5 in check "after" "" b "/get") ; case "services" (fun b -> let* _ = text b "/set?v=a" in let* url = text b "/coservice" in let* _ = text b "/timeout?kind=service&t=1" in let* () = check "before" "coservice" b url in let* () = sleep 1.5 in let* () = check "after" "fallback" b url in check "data kept" "a" b "/get") ; case "persistent data" (fun b -> let* _ = text b "/persistent/set?v=a" in let* _ = text b "/timeout?kind=persistent&t=1" in let* () = check "before" "a" b "/persistent/get" in let* () = sleep 1.5 in check "after" "" b "/persistent/get") ; case "no timeout" (fun b -> let* _ = text b "/set?v=a" in let* _ = text b "/timeout?kind=data&t=1" in let* _ = text b "/timeout?kind=data" in let* () = sleep 1.5 in check "kept" "a" b "/get") ] ) let coservices server = let case = case server in ( "coservices" , [ case "timeout" (fun b -> let* url = text b "/timed_coservice?t=1" in let* () = check "before" "coservice" b url in let* () = sleep 1.5 in check "after" "fallback" b url) ; case "maximum number of uses" (fun b -> let* url = text b "/counted_coservice?n=2" in let* () = check "first use" "coservice" b url in let* () = check "second use" "coservice" b url in check "third use" "fallback" b url) ] ) (* The expiration dates of the cookies set by a response *) let expirations (r : Browser.response) = List.map (fun h -> let expires = List.find_map (fun a -> match String.split_on_char '=' (String.trim a) with | [n; v] when String.lowercase_ascii n = "expires" -> Cookie_jar.parse_date v | _ -> None) (String.split_on_char ';' h) in expires) (Cohttp.Header.get_multi r.headers "set-cookie") (* [check_expiration msg ~now d r] checks that [r] sets one cookie, expiring [d] seconds after [now]. *) let check_expiration msg ~now d r = match expirations r with | [Some e] -> if e < now +. d -. 10. || e > now +. d +. 10. then Alcotest.failf "%s: expires at %.0f, %.0f s from now" msg e (e -. now) | _ -> Alcotest.failf "%s: one cookie with an expiration date expected" msg let cookies server = let case = case server in ( "cookies" , [ case "default" (fun b -> (* Ten years after the opening of the session *) let now = Unix.time () in let+ r = Browser.get b "/set?v=a" in check_expiration "in ten years" ~now 315532800. r) ; case "browser session" (fun b -> let* _ = text b "/set?v=a" in let+ r = Browser.get b "/cookie_expiration" in Alcotest.(check (list (option (float 0.)))) "no expiration date" [None] (expirations r)) ; case "expiration date" (fun b -> let* _ = text b "/set?v=a" in let now = Unix.time () in let+ r = Browser.get b "/cookie_expiration?t=3600" in check_expiration "in one hour" ~now 3600. r) ] ) let restart server = ( "restart" , [ Alcotest.test_case "persistent data" `Quick (fun () -> Lwt_main.run (let b = Browser.create server in let* _ = text b "/set?v=a" in let* _ = text b "/persistent/set?v=p" in Server_harness.restart server; let* () = check "persistent data kept" "p" b "/persistent/get" in check "volatile data lost" "" b "/get")) ] ) let () = Server_harness.with_server "./server.exe" (fun server -> Alcotest.run ~and_exit:false "eliom-server-timeouts" [states server; coservices server; cookies server; restart server]) eliom-13.0.0/test/site/000077500000000000000000000000001527170563500146365ustar00rootroot00000000000000eliom-13.0.0/test/site/dune000066400000000000000000000005511527170563500155150ustar00rootroot00000000000000; Tests with a site but no request: what an Eliom module does when it is ; initialised, as Ocsigen Server does it when it starts an application. (tests (names test_site test_default_app) (package eliom) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite ocsipersist-sqlite.settings re logs alcotest)) eliom-13.0.0/test/site/site.ml000066400000000000000000000023631527170563500161400ustar00rootroot00000000000000let hostname = "example.org" let http_port = 8080 let https_port = 8443 let config_info = { (Ocsigen.Extensions.default_config_info ()) with default_hostname = hostname ; default_httpport = http_port ; default_httpsport = https_port } (* The site data of an application are kept by Eliom for the next site of the same name. *) let apps = Hashtbl.create 16 let init ?(config_info = config_info) ?(site_dir = []) ?(run = fun ~app -> Eliom.App.run ~app ()) ~app f = if Hashtbl.mem apps app then invalid_arg ("Site.init: application " ^ app ^ " already used"); Hashtbl.add apps app (); let result = ref None in Eliom.Service.register_eliom_module app (fun () -> Eliom.Syntax.set_global true; Fun.protect ~finally:(fun () -> Eliom.Syntax.set_global false) (fun () -> result := Some (f ()))); Ocsigen.Extensions.start_initialisation (); Fun.protect ~finally:Ocsigen.Extensions.end_initialisation (fun () -> ignore (run ~app [] config_info site_dir : Ocsigen.Extensions.extension)); match !result with | Some r -> r | None -> failwith ("Site.init: " ^ app ^ " was not initialised") let register service = Eliom.Registration.Html_text.register ~service (fun _ _ -> Lwt.return "") eliom-13.0.0/test/site/site.mli000066400000000000000000000026731527170563500163150ustar00rootroot00000000000000(** A site for tests, without server. *) val hostname : string (** The default host name of the sites. *) val http_port : int (** The default HTTP port of the sites. *) val https_port : int (** The default HTTPS port of the sites. *) val config_info : Ocsigen.Extensions.config_info (** The default configuration of the host of the sites. *) val init : ?config_info:Ocsigen.Extensions.config_info -> ?site_dir:string list -> ?run:(app:string -> Ocsigen.Server.instruction) -> app:string -> (unit -> 'a) -> 'a (** [init ~config_info ~site_dir ~run ~app f] is the result of [f ()], run as the initialisation of the Eliom module [app] of a site at [site_dir] (default [[]]) of a host of configuration [config_info] (default {!config_info}), as Ocsigen Server does for an application linked statically: by [run ~app], default [Eliom.App.run ~app ()], which then checks that all the services of the site are registered. As in the toplevel code of an Eliom module, the client values created by [f] are global. The exceptions raised by [f] or by the check are raised again. @raise Invalid_argument if [app] was already used. *) val register : ( 'get , 'post , _ , _ , _ , Eliom.Service.non_ext , Eliom.Service.reg , _ , _ , _ , Eliom.Service.non_ocaml ) Eliom.Service.t -> unit (** [register service] registers an empty page as the handler of [service]. *) eliom-13.0.0/test/site/test_app_options.ml000066400000000000000000000114371527170563500205700ustar00rootroot00000000000000module Common = Eliom.Common module State = Eliom.State let session = Common.default_session_scope (* The settings of the current site read by the tests *) type settings = { xhr_links : bool ; data_timeout : float option ; service_timeout : float option ; persistent_timeout : float option ; max_service_sessions : int ; max_data_sessions : int ; max_persistent_sessions : int option ; max_service_tab_sessions : int ; max_data_tab_sessions : int ; max_persistent_tab_sessions : int option ; max_anonymous_services : int ; secure_cookies : bool ; ignored_get_params : string list } let settings () = let sitedata = Common.get_current_sitedata () in { xhr_links = Eliom.Config.get_default_links_xhr () ; data_timeout = State.get_global_volatile_data_state_timeout ~cookie_scope:session () ; service_timeout = State.get_global_service_state_timeout ~cookie_scope:session () ; persistent_timeout = State.get_global_persistent_data_state_timeout ~cookie_scope:session () ; max_service_sessions = sitedata.max_service_sessions_per_group.cf_value ; max_data_sessions = sitedata.max_volatile_data_sessions_per_group.cf_value ; max_persistent_sessions = sitedata.max_persistent_data_sessions_per_group.cf_value ; max_service_tab_sessions = sitedata.max_service_tab_sessions_per_group.cf_value ; max_data_tab_sessions = sitedata.max_volatile_data_tab_sessions_per_group.cf_value ; max_persistent_tab_sessions = sitedata.max_persistent_data_tab_sessions_per_group.cf_value ; max_anonymous_services = sitedata.max_anonymous_services_per_session.cf_value ; secure_cookies = sitedata.secure_cookies ; ignored_get_params = List.map fst sitedata.ignored_get_params } let run ~app = Eliom.App.run ~app ~xhr_links:false ~data_timeout:(`Session, None, Some 10.) ~service_timeout:(`Session, None, Some 20.) ~persistent_timeout:(`Session, None, Some 30.) ~max_service_sessions_per_group:3 ~max_volatile_data_sessions_per_group:4 ~max_persistent_data_sessions_per_group:5 ~max_service_tab_sessions_per_group:6 ~max_volatile_data_tab_sessions_per_group:7 ~max_persistent_data_tab_sessions_per_group:8 ~max_anonymous_services_per_session:9 ~secure_cookies:true ~ignored_get_params:("utm", Re.Posix.compile_pat "utm_.*") () let test_options () = let s = Site.init ~run ~app:"options" settings in Alcotest.(check bool) "XHR links" false s.xhr_links; Alcotest.(check (option (float 0.))) "data timeout" (Some 10.) s.data_timeout; Alcotest.(check (option (float 0.))) "service timeout" (Some 20.) s.service_timeout; Alcotest.(check (option (float 0.))) "persistent timeout" (Some 30.) s.persistent_timeout; Alcotest.(check int) "service sessions" 3 s.max_service_sessions; Alcotest.(check int) "data sessions" 4 s.max_data_sessions; Alcotest.(check (option int)) "persistent sessions" (Some 5) s.max_persistent_sessions; Alcotest.(check int) "service tab sessions" 6 s.max_service_tab_sessions; Alcotest.(check int) "data tab sessions" 7 s.max_data_tab_sessions; Alcotest.(check (option int)) "persistent tab sessions" (Some 8) s.max_persistent_tab_sessions; Alcotest.(check int) "anonymous services" 9 s.max_anonymous_services; Alcotest.(check bool) "secure cookies" true s.secure_cookies; Alcotest.(check (list string)) "ignored GET parameters" ["utm"] s.ignored_get_params let test_other_site () = (* The options of a site do not change the other sites. *) ignore (Site.init ~run ~app:"options, first site" settings : settings); let s = Site.init ~app:"options, other site" settings in Alcotest.(check bool) "XHR links" true s.xhr_links; (* The default timeout, one hour *) Alcotest.(check (option (float 0.))) "data timeout" (Some 3600.) s.data_timeout; Alcotest.(check bool) "secure cookies" false s.secure_cookies; Alcotest.(check (list string)) "ignored GET parameters" [] s.ignored_get_params let test_configuration_file () = (* A value given to App.run, as one of the configuration file, is only changed by the program when asked to. *) let run ~app = Eliom.App.run ~app ~max_service_sessions_per_group:3 () in let kept, overridden = Site.init ~run ~app:"options, configuration file" (fun () -> State.set_default_max_service_sessions_per_group 5; let kept = (settings ()).max_service_sessions in State.set_default_max_service_sessions_per_group ~override_configfile:true 5; kept, (settings ()).max_service_sessions) in Alcotest.(check int) "kept" 3 kept; Alcotest.(check int) "overridden" 5 overridden let suite = ( "options of App.run" , [ Alcotest.test_case "options" `Quick test_options ; Alcotest.test_case "other site" `Quick test_other_site ; Alcotest.test_case "configuration file" `Quick test_configuration_file ] ) eliom-13.0.0/test/site/test_app_options.mli000066400000000000000000000003371527170563500207360ustar00rootroot00000000000000(** Tests of the options of {!Eliom.App.run}, which configure the site of an application linked statically, as the options of a site do in a configuration file. *) val suite : string * unit Alcotest.test_case list eliom-13.0.0/test/site/test_default_app.ml000066400000000000000000000044311527170563500205150ustar00rootroot00000000000000(* The default application, as in a statically linked executable run by [Ocsigen.Server.start [host [Eliom.App.run ()]]]: the services are created and registered by the toplevel code of the modules, at the start of the program, which is in the initialisation phase of Ocsigen Server, before any site exists. Their registration is delayed until [App.run] gives them a site. There is one default application in a program, hence this separate executable. *) module Service = Eliom.Service module Parameter = Eliom.Parameter let service path = Service.create ~path:(Service.Path path) ~meth:(Service.Get Parameter.unit) () (* As the ppx does for the toplevel code of an Eliom module *) let () = Eliom.Syntax.set_global true let () = Eliom.Registration.Html_text.register ~service:(service ["registered"]) (fun () () -> Lwt.return "") let _unregistered = service ["unregistered"] let () = Eliom.Syntax.set_global false (* The site of the default application already exists: the defaults that the toplevel code sets with [Config] apply to it all the same. *) let default_site = Eliom.Common.get_current_sitedata () let () = Eliom.Config.set_secure_cookies true; Eliom.Config.set_html_content_type "text/x-test" let run = lazy (Eliom.App.run () [] Site.config_info ["s"]) let test_unregistered () = match Lazy.force run with | (_ : Ocsigen.Extensions.extension) -> Alcotest.fail "unregistered service accepted" | exception Eliom.Common.Eliom_there_are_unregistered_services (site, l, na) -> Alcotest.(check (list string)) "site" ["s"] site; Alcotest.(check (list (list string))) "services" [["unregistered"]] l; Alcotest.(check int) "non-attached coservices" 0 (List.length na) let test_config_defaults () = (try ignore (Lazy.force run : Ocsigen.Extensions.extension) with Eliom.Common.Eliom_there_are_unregistered_services _ -> ()); Alcotest.(check bool) "secure cookies" true default_site.secure_cookies; Alcotest.(check (option string)) "HTML content type" (Some "text/x-test") default_site.html_content_type let () = Alcotest.run "eliom-default-app" [ ( "default application" , [ Alcotest.test_case "unregistered" `Quick test_unregistered ; Alcotest.test_case "defaults of Config" `Quick test_config_defaults ] ) ] eliom-13.0.0/test/site/test_persistent_references.ml000066400000000000000000000116541527170563500226370ustar00rootroot00000000000000module Reference = Eliom.Reference module Common = Eliom.Common open Lwt.Syntax (* [on_site ?config_info ~app site_dir f] runs [f ()] during the initialisation of a site, where site references can be used. *) let on_site ?config_info ~app site_dir f = Site.init ?config_info ~site_dir ~app (fun () -> Lwt_main.run (f ())) let site_eref name default = Reference.eref ~scope:Common.site_scope ~persistent:(name, [%json: int]) default let test_site_scope () = let r = site_eref "test_site_scope" 0 in let default, modified = on_site ~app:"persistent-a" ["a"] (fun () -> let* default = Reference.get r in let* () = Reference.set r 1 in let* () = Reference.modify r succ in let+ modified = Reference.get r in default, modified) in Alcotest.(check int) "default value" 0 default; Alcotest.(check int) "modified" 2 modified; Alcotest.(check int) "other site" 0 (on_site ~app:"persistent-b" ["b"] (fun () -> Reference.get r)); (* The site is initialised again, as when the server is restarted. *) let kept, unset = on_site ~app:"persistent-a-again" ["a"] (fun () -> let* kept = Reference.get r in let* () = Reference.unset r in let+ unset = Reference.get r in kept, unset) in Alcotest.(check int) "same site" 2 kept; Alcotest.(check int) "unset" 0 unset let test_modify_later () = (* A modification started during the initialisation of a site, for instance by [Lwt.async], can end after it. *) let r = site_eref "test_modify_later" 0 in let modification = Site.init ~site_dir:["m"] ~app:"modify-later" (fun () -> Reference.modify r succ) in Lwt_main.run modification; Alcotest.(check int) "modified" 1 (on_site ~app:"modify-later-again" ["m"] (fun () -> Reference.get r)) let test_site_identity () = (* A site is identified by its directory only: its values are kept when the default host name changes, with the machine or the configuration. *) let r = site_eref "test_site_identity" 0 in on_site ~app:"identity" ["s"] (fun () -> Reference.set r 1); let other_host = {Site.config_info with Ocsigen.Extensions.default_hostname = "example.com"} in Alcotest.(check int) "other default host name" 1 (on_site ~config_info:other_host ~app:"identity-other-host" ["s"] (fun () -> Reference.get r)) let test_default_stored () = (* The default value is computed once, at the first read, and stored. *) let calls = ref 0 in let default () = incr calls; 10 * !calls in let r = Reference.eref_from_fun ~scope:Common.site_scope ~persistent:("test_default_stored", [%json: int]) default in Alcotest.(check int) "not called at creation" 0 !calls; let read app = on_site ~app ["stored"] (fun () -> Reference.get r) in Alcotest.(check int) "first read" 10 (read "stored"); Alcotest.(check int) "read again" 10 (read "stored-again"); Alcotest.(check int) "calls" 1 !calls let test_global_scope () = let r = Reference.eref ~scope:Common.global_scope ~persistent:("test_global_scope", [%json: int]) 0 in Lwt_main.run (Reference.set r 3); Alcotest.(check int) "on a site" 3 (on_site ~app:"persistent-global" ["g"] (fun () -> Reference.get r)); Alcotest.(check int) "modified" 4 (Lwt_main.run (let* () = Reference.modify r succ in Reference.get r)); Alcotest.(check int) "unset" 0 (Lwt_main.run (let* () = Reference.unset r in Reference.get r)) let test_unreadable () = (* A stored value that cannot be decoded, for instance after a change of type, is replaced by the default value. References with the same name share their value. *) let check kind scope run = let name = "test_unreadable_" ^ kind in let as_string = Reference.eref ~scope ~persistent:(name, [%json: string]) "default" in let as_int = Reference.eref ~scope ~persistent:(name, [%json: int]) 7 in let as_int_value, as_string_value = run (fun () -> let* () = Reference.set as_string "x" in let* as_int_value = Reference.get as_int in let+ as_string_value = Reference.get as_string in as_int_value, as_string_value) in Alcotest.(check int) "reset" 7 as_int_value; (* The value is stored, then unreadable in turn. *) Alcotest.(check string) "reset again" "default" as_string_value in check "site" Common.site_scope (on_site ~app:"unreadable" ["u"]); check "global" Common.global_scope (fun f -> Lwt_main.run (f ())) let suite = ( "persistent references" , [ Alcotest.test_case "site scope" `Quick test_site_scope ; Alcotest.test_case "modification ending after the initialisation" `Quick test_modify_later ; Alcotest.test_case "site identity" `Quick test_site_identity ; Alcotest.test_case "default value stored" `Quick test_default_stored ; Alcotest.test_case "global scope" `Quick test_global_scope ; Alcotest.test_case "unreadable value" `Quick test_unreadable ] ) eliom-13.0.0/test/site/test_persistent_references.mli000066400000000000000000000002441527170563500230010ustar00rootroot00000000000000(** Tests of persistent Eliom references of site and global scope, without request. They need a database. *) val suite : string * unit Alcotest.test_case list eliom-13.0.0/test/site/test_references.ml000066400000000000000000000073071527170563500203570ustar00rootroot00000000000000module Volatile = Eliom.Reference.Volatile module Common = Eliom.Common let test_site_scope () = let r = Volatile.eref ~scope:Common.site_scope 0 in let a = Site.init ~site_dir:["a"] ~app:"site-a" (fun () -> Volatile.set r 1; Volatile.get r) in let b = Site.init ~site_dir:["b"] ~app:"site-b" (fun () -> Volatile.get r) in Alcotest.(check int) "set on the site" 1 a; Alcotest.(check int) "other site" 0 b let test_site_scope_outside_a_site () = (* A program starts in the initialisation phase of Ocsigen Server, where site references are those of the default site. *) Ocsigen.Extensions.end_initialisation (); let r = Volatile.eref ~scope:Common.site_scope 0 in let check msg f = match f () with | () -> Alcotest.failf "%s: no error" msg | exception Common.Site_information_not_available _ -> () in check "get" (fun () -> ignore (Volatile.get r : int)); check "set" (fun () -> Volatile.set r 1); check "unset" (fun () -> Volatile.unset r) let test_global_scope () = let r = Volatile.eref ~scope:Common.global_scope 0 in Site.init ~site_dir:["a"] ~app:"global-a" (fun () -> Volatile.set r 1); Alcotest.(check int) "other site" 1 (Site.init ~site_dir:["b"] ~app:"global-b" (fun () -> Volatile.get r)); Alcotest.(check int) "outside a site" 1 (Volatile.get r) (* [counter ()] is a function returning 1, 2... at each call, and the number of its calls. *) let counter () = let calls = ref 0 in (fun () -> incr calls; !calls), calls let test_from_fun_site_scope () = let f, calls = counter () in let r = Volatile.eref_from_fun ~scope:Common.site_scope f in Alcotest.(check int) "not called at creation" 0 !calls; let reads ~app site_dir = Site.init ~site_dir ~app (fun () -> List.init 2 (fun _ -> Volatile.get r)) in Alcotest.(check (list int)) "first site" [1; 1] (reads ~app:"from-fun-a" ["a"]); Alcotest.(check (list int)) "second site" [2; 2] (reads ~app:"from-fun-b" ["b"]) let test_from_fun_global_scope () = let f, calls = counter () in let r = Volatile.eref_from_fun ~scope:Common.global_scope f in Alcotest.(check int) "not called at creation" 0 !calls; Alcotest.(check int) "first read" 1 (Volatile.get r); Alcotest.(check int) "second read" 1 (Volatile.get r); (* [unset] restores the default value, computed again. *) Volatile.unset r; Alcotest.(check int) "after unset" 2 (Volatile.get r) let test_scopes_needing_a_request () = let check msg scope = let r = Volatile.eref ~scope 0 in let check_operation name f = match f () with | () -> Alcotest.failf "%s, %s: no error" msg name | exception Common.Request_information_not_available _ -> () in Site.init ~app:("needing a request, " ^ msg) (fun () -> check_operation "get" (fun () -> ignore (Volatile.get r : int)); check_operation "set" (fun () -> Volatile.set r 1); check_operation "modify" (fun () -> Volatile.modify r succ); check_operation "unset" (fun () -> Volatile.unset r)) in check "session" Common.default_session_scope; check "session group" Common.default_group_scope; check "client process" Common.default_process_scope; check "request" Common.request_scope let suite = ( "references" , [ Alcotest.test_case "site scope" `Quick test_site_scope ; Alcotest.test_case "site scope outside a site" `Quick test_site_scope_outside_a_site ; Alcotest.test_case "global scope" `Quick test_global_scope ; Alcotest.test_case "from a function, site scope" `Quick test_from_fun_site_scope ; Alcotest.test_case "from a function, global scope" `Quick test_from_fun_global_scope ; Alcotest.test_case "scopes needing a request" `Quick test_scopes_needing_a_request ] ) eliom-13.0.0/test/site/test_references.mli000066400000000000000000000004231527170563500205200ustar00rootroot00000000000000(** Tests of Eliom references on a site, without request: site references have a value for each site, global references one for all, and references of other scopes can be created but neither read nor written. *) val suite : string * unit Alcotest.test_case list eliom-13.0.0/test/site/test_registration.ml000066400000000000000000000234021527170563500207420ustar00rootroot00000000000000module Service = Eliom.Service module Parameter = Eliom.Parameter module Html_text = Eliom.Registration.Html_text let service path = Service.create ~path:(Service.Path path) ~meth:(Service.Get Parameter.unit) () let coservice name = Service.create ~name ~path:Service.No_path ~meth:(Service.Get Parameter.unit) () (* [warnings f] is the result of [f ()] and the warnings logged meanwhile. *) let warnings f = let logged = ref [] in let report _src level ~over k msgf = msgf (fun ?header:_ ?tags:_ fmt -> Format.kasprintf (fun s -> if level = Logs.Warning then logged := s :: !logged; over (); k ()) fmt) in let reporter = Logs.reporter () in Logs.set_reporter {Logs.report}; Fun.protect ~finally:(fun () -> Logs.set_reporter reporter) (fun () -> let r = f () in r, List.rev !logged) let test_all_registered () = let (), logged = warnings (fun () -> Site.init ~site_dir:["s"] ~app:"registered" (fun () -> Site.register (service ["a"]); Site.register (service ["b"; "c"]); Site.register (coservice "na"))) in Alcotest.(check (list string)) "no warning" [] logged let test_unregistered () = match Site.init ~site_dir:["s"] ~app:"unregistered" (fun () -> Site.register (service ["a"]); ignore (service ["b"; "c"]); ignore (coservice "na")) with | () -> Alcotest.fail "unregistered services accepted" | exception Eliom.Common.Eliom_there_are_unregistered_services (site, l, na) -> Alcotest.(check (list string)) "site" ["s"] site; Alcotest.(check (list (list string))) "services" [["b"; "c"]] l; Alcotest.(check bool) "non-attached coservices" true (na = [Eliom.Common.SNa_get_ "na"]) let test_unregistered_non_attached () = (* Libraries create non-attached coservices that applications may not use: they are only reported. *) let (), logged = warnings (fun () -> Site.init ~site_dir:["s"] ~app:"unregistered-na" (fun () -> Site.register (coservice "used"); ignore (coservice "unused"))) in Alcotest.(check (list string)) "warning" [ "In site /s - The non-attached GET service \"unused\" has not been registered." ] logged let test_allow_unregistered () = (* A library creates services for a feature that applications may not use. *) let (), logged = warnings (fun () -> Site.init ~site_dir:["s"] ~app:"allow-unregistered" (fun () -> Service.allow_unregistered (service ["a"]); Service.allow_unregistered (coservice "na"))) in Alcotest.(check (list string)) "no warning" [] logged let test_allow_unregistered_registered () = (* An application that uses the feature registers the services. *) let (), logged = warnings (fun () -> Site.init ~site_dir:["s"] ~app:"allow-registered" (fun () -> let s = service ["a"] and c = coservice "na" in Service.allow_unregistered s; Service.allow_unregistered c; Site.register s; Site.register c)) in Alcotest.(check (list string)) "no warning" [] logged let test_allow_unregistered_attached_coservice () = (* The fallback of an attached coservice is still checked. *) match Site.init ~site_dir:["s"] ~app:"allow-attached" (fun () -> let fallback = service ["a"] in Service.allow_unregistered (Service.create_attached_get ~fallback ~get_params:Parameter.unit ())) with | () -> Alcotest.fail "unregistered fallback accepted" | exception Eliom.Common.Eliom_there_are_unregistered_services (_, l, _) -> Alcotest.(check (list (list string))) "services" [["a"]] l let test_buses () = (* The service of a bus of client processes is registered for each of them, during requests. *) let (), logged = warnings (fun () -> Site.init ~app:"buses" (fun () -> ignore (Eliom.Bus.create [%json: int]); ignore (Eliom.Bus.create ~scope:Eliom.Common.default_process_scope [%json: int]))) in Alcotest.(check (list string)) "no warning" [] logged let test_registered_twice () = match Site.init ~app:"twice" (fun () -> let s = service ["a"] in Site.register s; Site.register s) with | () -> Alcotest.fail "registered twice" | exception Eliom.Common.Eliom_duplicate_registration path -> Alcotest.(check string) "path" "a" path let test_duplicates () = (* [check msg expected f] checks that the registrations of [f] fail with [Eliom_duplicate_registration expected], or are accepted if [expected] is [None]. *) let check msg expected f = match Site.init ~app:("duplicates, " ^ msg) f with | () -> Alcotest.(check (option string)) msg expected None | exception Eliom.Common.Eliom_duplicate_registration s -> Alcotest.(check (option string)) msg expected (Some s) in let get path params = Service.create ~path:(Service.Path path) ~meth:(Service.Get params) () in check "same path and parameters" (Some "a") (fun () -> Site.register (service ["a"]); Site.register (service ["a"])); check "same path, other parameters" None (fun () -> Site.register (get ["a"] (Parameter.int "i")); Site.register (get ["a"] (Parameter.string "s"))); check "non-attached coservices with the same name" (Some "GET non-attached service na") (fun () -> Site.register (coservice "na"); Site.register (coservice "na")); check "anonymous non-attached coservices" None (fun () -> let anonymous () = Service.create ~path:Service.No_path ~meth:(Service.Get Parameter.unit) () in Site.register (anonymous ()); Site.register (anonymous ())); check "attached coservices with the same name" (Some "a (coservice n)") (fun () -> let fallback = service ["a"] in let named () = Service.create_attached_get ~name:"n" ~fallback ~get_params:Parameter.unit () in Site.register fallback; Site.register (named ()); Site.register (named ())); check "anonymous attached coservices" None (fun () -> let fallback = service ["a"] in let anonymous () = Service.create_attached_get ~fallback ~get_params:Parameter.unit () in Site.register fallback; Site.register (anonymous ()); Site.register (anonymous ())) let test_page_erasing () = (* A path cannot be both a page and a directory. *) let check msg first second = match Site.init ~app:("erasing, " ^ msg) (fun () -> Site.register (service first); Site.register (service second)) with | () -> Alcotest.failf "%s: accepted" msg | exception Eliom.Common.Eliom_page_erasing s -> Alcotest.(check string) msg "a" s in check "page, then page below" ["a"] ["a"; "b"]; check "page below, then page" ["a"; "b"] ["a"]; check "page, then directory" ["a"] ["a"; ""]; check "directory, then page" ["a"; ""] ["a"] let test_session_registration () = (* Services of a session are registered during a request. *) match Site.init ~app:"session registration" (fun () -> Html_text.register ~scope:Eliom.Common.default_session_scope ~service:(service ["a"]) (fun () () -> Lwt.return "")) with | () -> Alcotest.fail "registered" | exception Eliom.Common.Request_information_not_available f -> Alcotest.(check string) "function" "Registration.register" f let test_registration_after_the_initialisation () = (* Outside a request, services are registered during the initialisation of their site. A non-attached coservice, which may be left unregistered, is created during the initialisation and registered after it. *) let na, (_ : string list) = warnings (fun () -> Site.init ~app:"after" (fun () -> coservice "after")) in match Site.register na with | () -> Alcotest.fail "registered" | exception Eliom.Common.Site_information_not_available f -> Alcotest.(check string) "function" "register" f let test_current_site_restored () = (* Once a site is initialised, even when its check fails, the services created afterwards go to the default site of the program again, which has no directory, since the tests do not run the default application. *) let current_site_dir () = (Eliom.Common.get_current_sitedata ()).site_dir in Site.init ~site_dir:["ok"] ~app:"restored-ok" ignore; Alcotest.(check (option (list string))) "after a site" None (current_site_dir ()); (match Site.init ~site_dir:["failed"] ~app:"restored-failed" (fun () -> ignore (service ["a"])) with | () -> Alcotest.fail "unregistered service accepted" | exception Eliom.Common.Eliom_there_are_unregistered_services _ -> ()); Alcotest.(check (option (list string))) "after a failed site" None (current_site_dir ()) let suite = ( "registration" , [ Alcotest.test_case "all registered" `Quick test_all_registered ; Alcotest.test_case "unregistered" `Quick test_unregistered ; Alcotest.test_case "unregistered non-attached coservice" `Quick test_unregistered_non_attached ; Alcotest.test_case "allow unregistered" `Quick test_allow_unregistered ; Alcotest.test_case "allow unregistered, then registered" `Quick test_allow_unregistered_registered ; Alcotest.test_case "allow unregistered attached coservice" `Quick test_allow_unregistered_attached_coservice ; Alcotest.test_case "buses" `Quick test_buses ; Alcotest.test_case "registered twice" `Quick test_registered_twice ; Alcotest.test_case "duplicates" `Quick test_duplicates ; Alcotest.test_case "page erasing" `Quick test_page_erasing ; Alcotest.test_case "session registration" `Quick test_session_registration ; Alcotest.test_case "registration after the initialisation" `Quick test_registration_after_the_initialisation ; Alcotest.test_case "current site restored" `Quick test_current_site_restored ] ) eliom-13.0.0/test/site/test_registration.mli000066400000000000000000000006611527170563500211150ustar00rootroot00000000000000(** Tests of the registration of services on a site: services left unregistered at the end of the initialisation of the site, which is an error for services with a path and a warning for non-attached coservices, services registered twice or on the same path and parameters, paths used both as a page and as a directory, and registrations that need a request. *) val suite : string * unit Alcotest.test_case list eliom-13.0.0/test/site/test_services.ml000066400000000000000000000274411527170563500200620ustar00rootroot00000000000000module Service = Eliom.Service module Parameter = Eliom.Parameter module Uri = Eliom.Eliom_uri (* Services are registered, since a site checks that all its services are. *) let get ?https path params = let service = Service.create ?https ~path:(Service.Path path) ~meth:(Service.Get params) () in Site.register service; service let test_outside_a_site () = (* A program starts in the initialisation phase of Ocsigen Server, where services go to the default site: this is the case of services created outside a site, at runtime. *) Ocsigen.Extensions.end_initialisation (); match get ["a"] Parameter.unit with | _ -> Alcotest.fail "service created" | exception Eliom.Common.Site_information_not_available _ -> () let test_paths () = let path s = Uri.make_string_uri ~absolute_path:true ~service:s () in let paths = Site.init ~site_dir:["blog"] ~app:"paths" (fun () -> [ path (get ["a"; "b"] Parameter.unit) ; path (get ["dir"; ""] Parameter.unit) ; path (get [] Parameter.unit) ]) in Alcotest.(check (list string)) "paths" ["/blog/a/b"; "/blog/dir/"; "/blog/"] paths let test_full_path () = (* The path of a service from the root of the host, with the directory of its site *) let full_path s = match Service.info s with | Service.Attached att -> Service.full_path att | Service.Nonattached _ -> Alcotest.fail "not attached" in let paths = Site.init ~site_dir:["s"; "t"] ~app:"full path" (fun () -> [ full_path (get ["a"; "b"] Parameter.unit) ; full_path (get [] Parameter.unit) ]) in Alcotest.(check (list (list string))) "paths" [["s"; "t"; "a"; "b"]; ["s"; "t"; ""]] paths let test_path_escaping () = (* Each segment of the path of a service is escaped. *) let path = Site.init ~site_dir:["s"] ~app:"escaping" (fun () -> Uri.make_string_uri ~absolute_path:true ~service: (get ["a b"; "c%d"; "e?f"; "g#h"; "\xc3\xa9"; "i/j"; "k&l"; "m+n"] Parameter.unit) ()) in Alcotest.(check string) "path" "/s/a%20b/c%25d/e%3Ff/g%23h/%C3%A9/i%2Fj/k%26l/m%2Bn" path let test_site_levels () = let relative, absolute = Site.init ~site_dir:["a"; "b"] ~app:"levels" (fun () -> let s = get ["c"] Parameter.unit in ( Uri.make_string_uri ~absolute_path:true ~service:s () , Uri.make_string_uri ~absolute:true ~service:s () )) in Alcotest.(check string) "absolute path" "/a/b/c" relative; Alcotest.(check string) "absolute URL" (Printf.sprintf "http://%s:%d/a/b/c" Site.hostname Site.http_port) absolute let test_default_protocol () = let config_info = {Site.config_info with Ocsigen.Extensions.default_protocol_is_https = true} in let https, default, http = Site.init ~config_info ~app:"default protocol" (fun () -> let s = get ["a"] Parameter.unit in ( Eliom.Config.default_protocol_is_https () , Uri.make_string_uri ~absolute:true ~service:s () , Uri.make_string_uri ~absolute:true ~https:false ~service:s () )) in Alcotest.(check bool) "protocol" true https; Alcotest.(check string) "default" (Printf.sprintf "https://%s:%d/a" Site.hostname Site.https_port) default; Alcotest.(check string) "HTTP" (Printf.sprintf "http://%s:%d/a" Site.hostname Site.http_port) http let test_standard_ports () = (* The ports 80 and 443 are not written in URLs. *) let config_info = { Site.config_info with Ocsigen.Extensions.default_httpport = 80 ; default_httpsport = 443 } in let http, https = Site.init ~config_info ~app:"standard ports" (fun () -> let s = get ["a"] Parameter.unit in ( Uri.make_string_uri ~absolute:true ~service:s () , Uri.make_string_uri ~absolute:true ~https:true ~service:s () )) in Alcotest.(check string) "HTTP" ("http://" ^ Site.hostname ^ "/a") http; Alcotest.(check string) "HTTPS" ("https://" ^ Site.hostname ^ "/a") https let prefix = Printf.sprintf "http://%s:%d" Site.hostname Site.http_port let https_prefix = Printf.sprintf "https://%s:%d" Site.hostname Site.https_port let test_absolute_urls () = let urls = Site.init ~site_dir:["blog"] ~app:"absolute" (fun () -> let s = get ["a"] Parameter.(int "i" ** string "s") in let suffix = get ["b"] Parameter.(suffix (int "i" ** string "s")) in let secure = get ~https:true ["c"] Parameter.unit in let nl = Parameter.make_non_localized_parameters ~prefix:"app" ~name:"n" (Parameter.int "x") in let uri ?absolute ?absolute_path ?https ?fragment ?nl_params service v = Uri.make_string_uri ?absolute ?absolute_path ?https ?fragment ?nl_params ~service v in [ uri ~absolute:true s (1, "x y") ; uri ~absolute_path:true s (1, "x") ; uri ~absolute:true ~https:true s (1, "x") ; uri ~absolute:true suffix (3, "x/y") ; uri ~absolute:true secure () ; uri ~absolute_path:true ~fragment:"top" s (1, "x") ; uri ~absolute_path:true ~nl_params: (Parameter.add_nl_parameter Parameter.empty_nl_params_set nl 7) s (1, "x") ; uri ~absolute_path:true (Service.preapply ~service:s (2, "p")) () ]) in Alcotest.(check (list string)) "URLs" [ prefix ^ "/blog/a?s=x+y&i=1" ; "/blog/a?s=x&i=1" ; https_prefix ^ "/blog/a?s=x&i=1" ; prefix ^ "/blog/b/3/x%2Fy" ; https_prefix ^ "/blog/c" ; "/blog/a?s=x&i=1#top" ; "/blog/a?s=x&i=1&__nl_n_app-n.x=7" ; "/blog/a?s=p&i=2" ] urls let test_coservice_urls () = let urls = Site.init ~app:"coservices" (fun () -> let fallback = get ["a"] Parameter.unit in let anonymous = Service.create_attached_get ~fallback ~get_params:(Parameter.int "i") () in let named = Service.create_attached_get ~name:"named" ~fallback ~get_params:Parameter.unit () in Site.register anonymous; Site.register named; ( Uri.make_string_uri ~absolute_path:true ~service:anonymous 1 , Uri.make_string_uri ~absolute_path:true ~service:named () )) in let anonymous, named = urls in let path, params = match String.split_on_char '?' anonymous with | [path; params] -> path, String.split_on_char '&' params | _ -> Alcotest.failf "no parameters in %S" anonymous in Alcotest.(check string) "anonymous path" "/a" path; let state, others = List.partition (String.starts_with ~prefix:(Eliom.Common.get_numstate_param_name ^ "=")) params in Alcotest.(check int) "state parameter" 1 (List.length state); (* Parameters of attached coservices are prefixed, not to be mixed with those of the fallback. *) Alcotest.(check (list string)) "parameters" [Eliom.Common.co_param_prefix ^ "i=1"] others; Alcotest.(check string) "named" ("/a?" ^ Eliom.Common.get_state_param_name ^ "=named") named (* [state url] is the value of the state parameter of an anonymous attached coservice in [url]. *) let state url = let prefix = Eliom.Common.get_numstate_param_name ^ "=" in match List.find_opt (String.starts_with ~prefix) (String.split_on_char '&' (List.nth (String.split_on_char '?' url @ [""]) 1)) with | Some p -> String.sub p (String.length prefix) (String.length p - String.length prefix) | None -> Alcotest.failf "no state in %S" url let test_anonymous_coservices () = let first, again, second = Site.init ~app:"anonymous coservices" (fun () -> let fallback = get ["a"] Parameter.unit in let anonymous () = let s = Service.create_attached_get ~fallback ~get_params:Parameter.unit () in Site.register s; s in let url s = Uri.make_string_uri ~absolute_path:true ~service:s () in let first = anonymous () in url first, url first, url (anonymous ())) in Alcotest.(check string) "same coservice" (state first) (state again); Alcotest.(check bool) "other coservice" false (state first = state second) let test_post_urls () = (* The URL of a POST service and its POST parameters *) let show (path, get_params, fragment, post_params) = let names = List.map fst in path, get_params, fragment, names post_params, post_params in let attached, with_get = Site.init ~app:"POST" (fun () -> let fallback = get ["a"] Parameter.unit in let attached = Service.create_attached_post ~fallback ~post_params:(Parameter.string "v") () in let with_get = Service.create ~path:(Service.Path ["p"]) ~meth:(Service.Post (Parameter.int "g", Parameter.string "x")) () in Site.register attached; Site.register with_get; ( show (Uri.make_post_uri_components ~absolute_path:true ~service:attached () "x") , show (Uri.make_post_uri_components ~absolute_path:true ~service:with_get 3 "z") )) in let path, get_params, fragment, names, post_params = attached in Alcotest.(check string) "attached, path" "/a" path; Alcotest.(check (list (pair string string))) "attached, GET parameters" [] get_params; Alcotest.(check (option string)) "attached, fragment" None fragment; (* The parameters of attached coservices are prefixed, and the state of an anonymous POST coservice is a POST parameter. *) Alcotest.(check (list string)) "attached, POST parameters" [Eliom.Common.co_param_prefix ^ "v"; Eliom.Common.post_numstate_param_name] names; Alcotest.(check string) "attached, value" "x" (List.assoc (Eliom.Common.co_param_prefix ^ "v") post_params); let path, get_params, _, _, post_params = with_get in Alcotest.(check string) "path" "/p" path; Alcotest.(check (list (pair string string))) "GET parameters" ["g", "3"] get_params; Alcotest.(check (list (pair string string))) "POST parameters" ["x", "z"] post_params let test_urls_needing_a_request () = let check msg f = match f () with | s -> Alcotest.failf "%s: %S" msg s | exception Eliom.Common.Request_information_not_available _ -> () in Site.init ~app:"request" (fun () -> let s = get ["a"] Parameter.unit in let na = Service.create ~name:"na" ~path:Service.No_path ~meth:(Service.Get Parameter.unit) () in Site.register na; check "relative URL" (fun () -> Uri.make_string_uri ~service:s ()); check "non-attached coservice" (fun () -> Uri.make_string_uri ~absolute:true ~service:na ())) let test_configuration () = let hostname, port, sslport, https = Site.init ~app:"configuration" (fun () -> ( Eliom.Config.get_default_hostname () , Eliom.Config.get_default_port () , Eliom.Config.get_default_sslport () , Eliom.Config.default_protocol_is_https () )) in Alcotest.(check string) "hostname" Site.hostname hostname; Alcotest.(check int) "port" Site.http_port port; Alcotest.(check int) "HTTPS port" Site.https_port sslport; Alcotest.(check bool) "protocol" false https let suite = ( "services" , [ Alcotest.test_case "outside a site" `Quick test_outside_a_site ; Alcotest.test_case "paths" `Quick test_paths ; Alcotest.test_case "full path" `Quick test_full_path ; Alcotest.test_case "path escaping" `Quick test_path_escaping ; Alcotest.test_case "site on several levels" `Quick test_site_levels ; Alcotest.test_case "default protocol" `Quick test_default_protocol ; Alcotest.test_case "standard ports" `Quick test_standard_ports ; Alcotest.test_case "absolute URLs" `Quick test_absolute_urls ; Alcotest.test_case "coservice URLs" `Quick test_coservice_urls ; Alcotest.test_case "anonymous coservices" `Quick test_anonymous_coservices ; Alcotest.test_case "POST URLs" `Quick test_post_urls ; Alcotest.test_case "URLs needing a request" `Quick test_urls_needing_a_request ; Alcotest.test_case "configuration" `Quick test_configuration ] ) eliom-13.0.0/test/site/test_services.mli000066400000000000000000000003011527170563500202150ustar00rootroot00000000000000(** Tests of services created on a site: their paths, the URLs built for them without a request, and the site configuration they read. *) val suite : string * unit Alcotest.test_case list eliom-13.0.0/test/site/test_site.ml000066400000000000000000000006721527170563500172000ustar00rootroot00000000000000let () = (* A new database for each run *) let db = Filename.temp_file "eliom-test-site" ".sqlite" in Ocsipersist_settings.set_db_file db; Fun.protect ~finally:(fun () -> Sys.remove db) (fun () -> Alcotest.run ~and_exit:false "eliom-site" [ Test_services.suite ; Test_registration.suite ; Test_references.suite ; Test_persistent_references.suite ; Test_app_options.suite ]) eliom-13.0.0/test/unit/000077500000000000000000000000001527170563500146515ustar00rootroot00000000000000eliom-13.0.0/test/unit/dune000066400000000000000000000004071527170563500155300ustar00rootroot00000000000000; Unit tests: no request, no running server. Some tests create a site. (test (name test_unit) (package eliom) (preprocess (pps js_of_ocaml-ppx_deriving_json)) (libraries eliom.server ocsipersist-sqlite xml-light re alcotest eliom_test_server)) eliom-13.0.0/test/unit/test_config.ml000066400000000000000000000323301527170563500175100ustar00rootroot00000000000000module Main = Eliom.Mod_main module Gc = Eliom.Mod_gc (* [parse s] reads the options [s], the content of an element. *) let parse s = match Xml.parse_string ("" ^ s ^ "") with | Xml.Element (_, _, options) -> Main.parse_global_config options | Xml.PCData _ -> Alcotest.fail "not an element" let check_error msg expected s = match parse s with | () -> Alcotest.failf "%s: accepted" msg | exception Ocsigen.Extensions.Error_in_config_file e -> Alcotest.(check string) msg expected e (* A site of its own, for the options of the configuration of a site *) let site = lazy (Main.create_sitedata [] ["config"] (Ocsigen.Extensions.default_config_info ())) (* [parse_site s] reads the options [s], the content of an element of a site, and returns those left to the Eliom modules. *) let parse_site s = match Xml.parse_string ("" ^ s ^ "") with | Xml.Element (_, _, options) -> Main.parse_site_options (Lazy.force site) options | Xml.PCData _ -> Alcotest.fail "not an element" let check_site_error msg expected s = match parse_site s with | _ -> Alcotest.failf "%s: accepted in a site" msg | exception Ocsigen.Extensions.Error_in_config_file e -> Alcotest.(check string) (msg ^ ", in a site") expected e let frequency = Alcotest.(option (float 0.)) let test_gc_frequencies () = parse {||}; Alcotest.check frequency "service" (Some 10.) (Gc.get_servicesessiongcfrequency ()); Alcotest.check frequency "data" (Some 10.) (Gc.get_datasessiongcfrequency ()); parse {| |}; Alcotest.check frequency "service only" None (Gc.get_servicesessiongcfrequency ()); Alcotest.check frequency "data only" (Some 2.5) (Gc.get_datasessiongcfrequency ()); Alcotest.check frequency "persistent" (Some 3600.) (Gc.get_persistentsessiongcfrequency ()); check_error "not a number" "Eliom: Wrong value for " {||} let test_comet_timeout () = parse {||}; Alcotest.(check (float 0.)) "set" 2.5 (Main.get_comet_timeout ()); List.iter (fun v -> check_error v "Eliom: Wrong value for " (Printf.sprintf {||} v)) ["soon"; "0"; "-1"; "infinity"; "nan"]; Alcotest.(check (float 0.)) "unchanged" 2.5 (Main.get_comet_timeout ()); Alcotest.check_raises "not positive" (Invalid_argument "Eliom: the Comet timeout must be a positive number") (fun () -> Main.set_comet_timeout 0.); Main.set_comet_timeout 20. (* The limits, by name *) let limits = Main. [ "service sessions per group", default_max_service_sessions_per_group ; "data sessions per group", default_max_volatile_data_sessions_per_group ; ( "service sessions without group" , default_max_service_sessions_without_group ) ; ( "data sessions without group" , default_max_volatile_data_sessions_without_group ) ; ( "persistent sessions per group" , default_max_persistent_data_sessions_per_group ) ; ( "service tab sessions per group" , default_max_service_tab_sessions_per_group ) ; ( "data tab sessions per group" , default_max_volatile_data_tab_sessions_per_group ) ; ( "persistent tab sessions per group" , default_max_persistent_data_tab_sessions_per_group ) ; "coservices per session", default_max_anonymous_services_per_session ; "coservices per site", default_max_anonymous_services_per_site ; "groups per site", default_max_volatile_groups_per_site ] (* The options setting limits, each with the limits it sets *) let limit_options = [ ( "maxvolatilesessionspergroup" , ["service sessions per group"; "data sessions per group"] ) ; "maxservicesessionspergroup", ["service sessions per group"] ; "maxdatasessionspergroup", ["data sessions per group"] ; ( "maxvolatilesessionswithoutgroup" , ["service sessions without group"; "data sessions without group"] ) ; "maxservicesessionswithoutgroup", ["service sessions without group"] ; "maxdatasessionswithoutgroup", ["data sessions without group"] ; "maxpersistentsessionspergroup", ["persistent sessions per group"] ; ( "maxvolatiletabsessionspergroup" , ["service tab sessions per group"; "data tab sessions per group"] ) ; "maxservicetabsessionspergroup", ["service tab sessions per group"] ; "maxdatatabsessionspergroup", ["data tab sessions per group"] ; "maxpersistenttabsessionspergroup", ["persistent tab sessions per group"] ; "maxanonymouscoservicespersession", ["coservices per session"] ; "maxanonymouscoservicespersite", ["coservices per site"] ; "maxvolatilegroupspersite", ["groups per site"] ] let test_limits () = (* Each option sets its limits, and no other one. *) List.iteri (fun i (tag, set) -> let value = 100 + i in let before = List.map (fun (_, r) -> !r) limits in parse (Printf.sprintf {|<%s value="%d"/>|} tag value); List.iter2 (fun (name, r) old -> let expected = if List.mem name set then value else old in Alcotest.(check int) (tag ^ ": " ^ name) expected !r) limits before) limit_options; check_error "not an integer" "Eliom: Wrong attribute value for maxdatasessionspergroup tag" {||}; (* A limit must be positive *) List.iter (fun (tag, _) -> List.iter (fun v -> let before = List.map (fun (_, r) -> !r) limits in let msg = Printf.sprintf "%s=%d" tag v and expected = Printf.sprintf "Eliom: Wrong attribute value for %s tag: the maximum must be positive" tag and option = Printf.sprintf {|<%s value="%d"/>|} tag v in check_error msg expected option; check_site_error msg expected option; Alcotest.(check (list int)) (tag ^ ": unchanged") before (List.map (fun (_, r) -> !r) limits)) [0; -1]) limit_options; Alcotest.check_raises "Config" (Invalid_argument "Config.set_max_service_sessions_per_group: the maximum must be positive") (fun () -> Eliom.Config.set_max_service_sessions_per_group 0) (* The options renamed or removed in Eliom 13 are errors, which tell what replaces them, also in the configuration of a site. *) let test_renamed () = let renamed what tag new_tag = ( tag , Printf.sprintf "Eliom: <%s> is now <%s>, which limits %s" tag new_tag what ) and removed tag = ( tag , Printf.sprintf "Eliom: <%s> is removed: the anonymous coservices of the global table are now limited for the whole site ()" tag ) in let sessions = renamed "the sessions without a group of the whole site" in List.iter (fun (tag, expected) -> let option = Printf.sprintf {|<%s value="10"/>|} tag in check_error tag expected option; check_site_error tag expected option) [ sessions "maxvolatilesessionspersubnet" "maxvolatilesessionswithoutgroup" ; sessions "maxservicesessionspersubnet" "maxservicesessionswithoutgroup" ; sessions "maxdatasessionspersubnet" "maxdatasessionswithoutgroup" ; renamed "the anonymous coservices of the global table of the whole site" "maxanonymouscoservicespersubnet" "maxanonymouscoservicespersite" ; removed "ipv4subnetmask" ; removed "ipv6subnetmask" ] (* When the configuration of a site is read again (the server reloads it), a new limit of the sessions without a group applies to the existing ones: the sessions used least recently are closed. *) let test_site_reload () = let sitedata = Lazy.force site in let group = Eliom.Mod_sessiongroups.make_full_group_name ~cookie_level:`Session ~sitedata None in List.iter (fun id -> ignore (Eliom.Mod_sessiongroups.Data.add sitedata id group)) ["s1"; "s2"; "s3"]; Alcotest.(check int) "before" 3 (Eliom.Mod_sessiongroups.Data.group_size group); ignore (parse_site {||}); Alcotest.(check int) "after" 2 (Eliom.Mod_sessiongroups.Data.group_size group) (* In the configuration of a site, the options of Eliom apply to the site, and the other ones are left to the Eliom modules. *) let test_site_options () = match parse_site {||} with | [Xml.Element ("mymodule", [("a", "b")], [])] -> Alcotest.(check int) "limit of the site" 3 (Lazy.force site).Eliom.Common.max_volatile_data_sessions_per_group .Eliom.Common.cf_value | _ -> Alcotest.fail "options left to the modules" let test_cookies () = parse {||}; Alcotest.(check bool) "secure cookies" true !Main.default_secure_cookies; parse {||}; Alcotest.(check bool) "insecure cookies" false !Main.default_secure_cookies; check_error "not a boolean" "Eliom: Wrong attribute value for securecookies tag" {||} let test_client_program () = parse {||}; let {Eliom.Common.defer; async} = !Main.default_application_script in Alcotest.(check (pair bool bool)) "script" (true, false) (defer, async); Alcotest.(check bool) "wasm" true !Main.default_enable_wasm; parse {||}; Alcotest.(check (option (pair (list string) int))) "global data caching" (Some (["gd"; "data"], 60)) !Main.default_cache_global_data; parse {||}; Alcotest.(check (option string)) "HTML content type" (Some "text/html") !Main.default_html_content_type; check_error "wrong script attribute" "Eliom: attribute src not allowed in element applicationscript" {||}; check_error "wrong boolean" "Eliom: Wrong attribute value for tag defer in element applicationscript" {||}; check_error "wrong cache duration" "Eliom: Wrong attribute value for tag cache in element cacheglobaldata" {||}; check_error "wrong wasm attribute" "Eliom: Wrong attribute value for wasm tag" {||} let test_ignored_params () = Main.default_ignored_get_params := []; Main.default_ignored_post_params := []; parse {||}; match !Main.default_ignored_get_params, !Main.default_ignored_post_params with | [(s, re)], [(s', re')] -> Alcotest.(check string) "source" "utm_.*" s; Alcotest.(check bool) "matches" true (Re.execp re "utm_source"); Alcotest.(check bool) "whole name" false (Re.execp re "a_utm_source"); Alcotest.(check string) "POST source" "x" s'; Alcotest.(check bool) "POST whole name" false (Re.execp re' "xx") | _ -> Alcotest.fail "ignored parameters not recorded" let test_omit_persistent_storage () = parse {|
|}; (match !Main.default_omitpersistentstorage with | Some [Eliom.Common.HeaderRule (name, re)] -> Alcotest.(check string) "header" "user-agent" (Ocsigen_http.Header.Name.to_string name); Alcotest.(check bool) "regexp" true (Re.execp re "Googlebot/2.1") | _ -> Alcotest.fail "rules not recorded"); check_error "wrong rule" "Eliom: only accepts
elements" {||} let test_timeout_errors () = check_error "missing value" "Eliom: Missing value for datatimeout tag" {||}; check_error "wrong value" "Eliom: Wrong attribute value for servicetimeout tag" {||}; check_error "wrong level" "Eliom: Wrong attribute value for level in volatiletimeout tag" {||}; check_error "wrong attribute" "Eliom: Wrong attribute name for persistenttimeout tag" {||} let test_unknown () = check_error "unknown option" "Unexpected content inside eliom config" {||}; check_error "text" "Unexpected content inside eliom config" "text" let suite = ( "config" , [ Alcotest.test_case "GC frequencies" `Quick test_gc_frequencies ; Alcotest.test_case "Comet timeout" `Quick test_comet_timeout ; Alcotest.test_case "limits" `Quick test_limits ; Alcotest.test_case "renamed options" `Quick test_renamed ; Alcotest.test_case "options of a site" `Quick test_site_options ; Alcotest.test_case "options of a site, read again" `Quick test_site_reload ; Alcotest.test_case "secure cookies" `Quick test_cookies ; Alcotest.test_case "client program" `Quick test_client_program ; Alcotest.test_case "ignored parameters" `Quick test_ignored_params ; Alcotest.test_case "omit persistent storage" `Quick test_omit_persistent_storage ; Alcotest.test_case "timeout errors" `Quick test_timeout_errors ; Alcotest.test_case "unknown options" `Quick test_unknown ] ) eliom-13.0.0/test/unit/test_config.mli000066400000000000000000000003171527170563500176610ustar00rootroot00000000000000(** Tests of the global Eliom configuration read from the server configuration file: accepted options, their effect on the defaults, and errors. *) val suite : string * unit Alcotest.test_case list eliom-13.0.0/test/unit/test_content.ml000066400000000000000000000102531527170563500177150ustar00rootroot00000000000000module Html = Eliom.Content.Html let contains = Eliom_test_server.Helpers.contains let print elt = Format.asprintf "%a" (Html.Printer.pp_elt ()) elt let print_doc doc = Format.asprintf "%a" (Eliom.Content_core.Html.Printer.pp ()) doc let check_contains msg s sub = if not (contains s sub) then Alcotest.failf "%s: %S not in %S" msg sub s let check_absent msg s sub = if contains s sub then Alcotest.failf "%s: %S in %S" msg sub s (* [ids s] are the values of the node identifier attributes in [s]. *) let ids s = let attr = Eliom.Runtime.RawXML.node_id_attrib ^ "=\"" in let n = String.length attr in let rec loop i acc = if i + n > String.length s then List.rev acc else if String.sub s i n = attr then let j = String.index_from s (i + n) '"' in loop j (String.sub s (i + n) (j - i - n) :: acc) else loop (i + 1) acc in loop 0 [] let test_functional_nodes () = Alcotest.(check string) "no identifier" "

a

" (print Html.F.(div ~a:[a_class ["c"]] [p [txt "a"]])) let test_escaping () = let s = print Html.F.( div ~a:[a_title "\">"] [txt ""]) in check_absent "text" s "" let test_error_param_type () = let s = print_doc (Eliom.Error_pages.page_error_param_type [evil, Failure "x"; "j", Failure "y"]) in check_contains "names" s "j"; check_absent "escaped" s "