├── .gitignore ├── sks ├── etc │ └── sks │ │ ├── membership │ │ ├── sksconf │ │ └── DB_CONFIG └── bin │ ├── sks-db-upgrade │ └── sks-init ├── s6 ├── services.d │ ├── sks-db │ │ ├── run │ │ └── finish │ ├── sks-recon │ │ └── run │ ├── sks-log-clean │ │ └── run │ └── sks-stats │ │ └── run └── fix-attrs.d │ └── 01-sks-data-dir ├── keydump ├── entrypoint.sh └── Dockerfile ├── Dockerfile ├── entrypoint.sh ├── patches ├── poison-key.diff ├── fix-build-failure.diff └── deprecated-ocaml.diff └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | tmp 2 | .env 3 | -------------------------------------------------------------------------------- /sks/etc/sks/membership: -------------------------------------------------------------------------------- 1 | # keyserver.linux.it 11370 2 | -------------------------------------------------------------------------------- /s6/services.d/sks-db/run: -------------------------------------------------------------------------------- 1 | #!/bin/execlineb -P 2 | sks -stdoutlog -basedir /var/lib/sks db 3 | -------------------------------------------------------------------------------- /s6/fix-attrs.d/01-sks-data-dir: -------------------------------------------------------------------------------- 1 | /var/lib/sks false root 0644 0755 2 | /var/lib/sks/KDB true root 0600 0700 3 | /var/lib/sks/PTree true root 0600 0700 4 | -------------------------------------------------------------------------------- /s6/services.d/sks-db/finish: -------------------------------------------------------------------------------- 1 | #!/bin/execlineb -S1 2 | if { s6-test ${1} -ne 0 } 3 | if { s6-test ${1} -ne 256 } 4 | s6-svscanctl -t /var/run/s6/services 5 | -------------------------------------------------------------------------------- /s6/services.d/sks-recon/run: -------------------------------------------------------------------------------- 1 | #!/bin/execlineb -P 2 | foreground 3 | { 4 | s6-svwait /var/run/s6/services/sks-db 5 | } 6 | sks -stdoutlog -basedir /var/lib/sks recon 7 | -------------------------------------------------------------------------------- /s6/services.d/sks-log-clean/run: -------------------------------------------------------------------------------- 1 | #!/bin/execlineb -P 2 | loopwhilex foreground { 3 | foreground { db_archive -d -h /var/lib/sks/KDB } 4 | db_archive -d -h /var/lib/sks/PTree 5 | } sleep 7200 6 | -------------------------------------------------------------------------------- /s6/services.d/sks-stats/run: -------------------------------------------------------------------------------- 1 | #!/bin/execlineb -P 2 | foreground 3 | { 4 | s6-svwait /var/run/s6/services/sks-db 5 | } 6 | loopwhilex foreground { 7 | s6-svc -2 /var/run/s6/services/sks-db 8 | } sleep 1800 9 | -------------------------------------------------------------------------------- /sks/etc/sks/sksconf: -------------------------------------------------------------------------------- 1 | debuglevel: 1 2 | hostname: sks.example.com 3 | server_contact: 0xDEADBEEF 4 | recon_address: 0.0.0.0 5 | recon_port: 11370 6 | hkp_address: 0.0.0.0 7 | hkp_port: 11371 8 | initial_stat: 9 | disable_mailsync: 10 | pagesize: 16 11 | ptree_pagesize: 16 12 | -------------------------------------------------------------------------------- /keydump/entrypoint.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Start daemons 4 | if [ $# -gt 0 ];then 5 | exec "$@" 6 | else 7 | (cd /var/lib/sks/dump && 8 | wget --quiet --recursive --no-parent --no-directories \ 9 | --accept pgp --execute robots=off --no-check-certificate ${KEYDUMP_URL}) 10 | fi -------------------------------------------------------------------------------- /sks/bin/sks-db-upgrade: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cd /var/lib/sks/KDB/ || exit 1 3 | for i in $(ls -1 | grep -Ev "^(__|log\.|DB_CONFIG$)" || true) 4 | do 5 | db_upgrade "$i" 6 | done 7 | 8 | cd /var/lib/sks/PTree || exit 1 9 | for i in $(ls -1 | grep -Ev "^(__|log\.|DB_CONFIG$)" || true) 10 | do 11 | db_upgrade "$i" 12 | done 13 | -------------------------------------------------------------------------------- /keydump/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM debian:latest 2 | LABEL maintainer="Jeremy T. Bouse " 3 | 4 | ENV KEYDUMP_URL="https://mirror.cyberbits.eu/sks/dump/" 5 | 6 | COPY entrypoint.sh / 7 | 8 | RUN set -ex \ 9 | && apt-get update && apt-get install -y \ 10 | jq \ 11 | curl \ 12 | wget \ 13 | rsync \ 14 | && mkdir -p /var/lib/sks/dump \ 15 | && rm -rf /var/lib/apt/lists/* \ 16 | && chmod +x /entrypoint.sh 17 | 18 | WORKDIR /var/lib/sks 19 | ENTRYPOINT [ "/entrypoint.sh" ] -------------------------------------------------------------------------------- /sks/bin/sks-init: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cd /var/lib/sks || exit 1 3 | if [ -d dump ] && [ "$(echo dump/*.pgp)" != "dump/*.pgp" ]; then 4 | sks build dump/*.pgp -n 10 -cache 100 5 | sks cleandb 6 | sks pbuild -cache 20 -ptree_cache 70 7 | fi 8 | if [ ! -e sksconf ]; then 9 | cp /usr/local/etc/sks/sksconf . 10 | fi 11 | if [ ! -e membership ]; then 12 | cp /usr/local/etc/sks/membership . 13 | fi 14 | # Commented out as web is handled outside this container 15 | # if [ ! -e web ]; then 16 | # cp -r /usr/local/etc/sks/web . 17 | # fi 18 | -------------------------------------------------------------------------------- /sks/etc/sks/DB_CONFIG: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* DB_CONFIG - Sample Berkeley DB tunables for use with SKS *# 3 | #* *# 4 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 5 | #* *# 6 | #* This file is part of SKS. SKS is free software; you can *# 7 | #* redistribute it and/or modify it under the terms of the GNU General *# 8 | #* Public License as published by the Free Software Foundation; either *# 9 | #* version 2 of the License, or (at your option) any later version. *# 10 | #* *# 11 | #* This program is distributed in the hope that it will be useful, but *# 12 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 13 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 14 | #* General Public License for more details. *# 15 | #* *# 16 | #* You should have received a copy of the GNU General Public License *# 17 | #* along with this program; if not, write to the Free Software *# 18 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 19 | #* USA or see . *# 20 | #************************************************************************# 21 | 22 | set_mp_mmapsize 268435456 23 | set_cachesize 0 134217728 1 24 | set_flags DB_LOG_AUTOREMOVE 25 | set_lg_regionmax 1048576 26 | set_lg_max 104857600 27 | set_lg_bsize 2097152 28 | set_lk_detect DB_LOCK_DEFAULT 29 | set_tmp_dir /tmp 30 | set_lock_timeout 1000 31 | set_txn_timeout 1000 32 | mutex_set_max 65536 -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM alpine:3.7 AS build 2 | 3 | COPY patches /tmp/patches/ 4 | 5 | RUN set -ex && \ 6 | apk upgrade --no-cache && \ 7 | apk add --no-cache \ 8 | build-base camlp4 db-dev gcc libc-dev zlib-dev curl jq && \ 9 | curl -sSL $(curl -s https://api.github.com/repos/SKS-Keyserver/sks-keyserver/releases/latest |jq -r '.assets[] | select(.content_type | contains("application/x-compressed-tar")) | .browser_download_url') | tar xzC /tmp && \ 10 | cd /tmp/sks-* && \ 11 | patch -p1 Makefile.local && \ 15 | make dep && \ 16 | make cryptokit-1.7/README.txt && \ 17 | sed -i 's/uint32/uint32_t/g' cryptokit-1.7/src/stubs-md5.c && \ 18 | make sks && \ 19 | install -m755 sks /usr/sbin/sks 20 | 21 | FROM alpine:3 22 | LABEL maintainer="Jeremy T. Bouse " 23 | 24 | ENV S6_BEHAVIOR_IF_STAGE2_FAILS=2 \ 25 | SKS_HOSTNAME="localhost" \ 26 | SKS_RECON_ADDR="0.0.0.0" \ 27 | SKS_RECON_PORT="11370" \ 28 | SKS_HKP_ADRESS="0.0.0.0" \ 29 | SKS_HKP_PORT="11371" \ 30 | SKS_SERVER_CONTACT="" \ 31 | SKS_NODENAME="keys" \ 32 | SKS_COMMAND_TIMEOUT="600" \ 33 | SKS_WSERVER_TIMEOUT="30" \ 34 | SKS_MAX_RECOVER="150" \ 35 | SKS_INIT_BUILD_FILES="10" \ 36 | SKS_INIT_BUILD_CACHE="100" \ 37 | SKS_INIT_PBUILD_CACHE="20" \ 38 | SKS_INIT_PTREE_CACHE="70" 39 | 40 | COPY --from=build /usr/sbin/sks /usr/sbin/ 41 | COPY sks /usr/local/ 42 | COPY s6 /etc/ 43 | COPY entrypoint.sh / 44 | 45 | RUN set -ex && \ 46 | apk upgrade --no-cache && \ 47 | apk add --no-cache db-utils && \ 48 | apk add --no-cache --virtual .sks-setup \ 49 | curl jq && \ 50 | curl -sSL $(curl -s https://api.github.com/repos/just-containers/s6-overlay/releases/latest |jq -r '.assets[] | select(.browser_download_url | endswith("amd64.tar.gz")) | .browser_download_url') | tar xzC / && \ 51 | apk del --purge .sks-setup && \ 52 | mkdir -p /data && \ 53 | mkdir -p /var/lib/sks && \ 54 | chmod +x /entrypoint.sh 55 | 56 | WORKDIR /var/lib/sks 57 | 58 | VOLUME /var/lib/sks 59 | EXPOSE 11371 11370 60 | 61 | ENTRYPOINT ["/entrypoint.sh"] 62 | -------------------------------------------------------------------------------- /entrypoint.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | fail() { echo Command failed unexpectedly. Bailing out; exit 1; } 4 | 5 | # 6 | # Make basic SKS config file 7 | # 8 | if ! test -f sksconf; then 9 | cat > sksconf << EOF 10 | hostname: ${SKS_HOSTNAME} 11 | recon_address: ${SKS_RECON_ADDR} 12 | recon_port: ${SKS_RECON_PORT} 13 | hkp_address: ${SKS_HKP_ADRESS} 14 | hkp_port: ${SKS_HKP_PORT} 15 | initial_stat: 16 | pagesize: 16 17 | ptree_pagesize: 16 18 | nodename: ${SKS_NODENAME} 19 | disable_mailsync: 20 | debuglevel: 3 21 | membership_reload_interval: 1 22 | stat_hour: 17 23 | server_contact: ${SKS_SERVER_CONTACT} 24 | command_timeout: 600 25 | wserver_timeout: 30 26 | max_recover: 150 27 | EOF 28 | else 29 | sed -i "\ 30 | s/hostname:.*/hostname: ${SKS_HOSTNAME}/g; \ 31 | s/recon_address:.*/recon_address: ${SKS_RECON_ADDR}/g; \ 32 | s/recon_port:.*/recon_port: ${SKS_RECON_PORT}/g; \ 33 | s/hkp_address:.*/hkp_address: ${SKS_HKP_ADRESS}/g; \ 34 | s/hkp_port:.*/hkp_port: ${SKS_HKP_PORT}/g; \ 35 | s/nodename:.*/nodename: ${SKS_NODENAME}/g; \ 36 | s/server_contact:.*/server_contact: ${SKS_SERVER_CONTACT}/g; \ 37 | s/command_timeout:.*/command_timeout: ${SKS_COMMAND_TIMEOUT}/g; \ 38 | s/wserver_timeout:.*/wserver_timeout: ${SKS_WSERVER_TIMEOUT}/g; \ 39 | s/max_recover:.*/max_recover: ${SKS_MAX_RECOVER}/g; \ 40 | " sksconf 41 | fi 42 | 43 | # 44 | # Copy membership file 45 | # 46 | if ! test -f membership; then 47 | cp -a /usr/local/etc/sks/membership . 48 | fi 49 | 50 | 51 | # 52 | # Copy BDB DB_CONFIG file 53 | # 54 | if ! test -f DB_CONFIG; then 55 | cp -a /usr/local/etc/sks/DB_CONFIG . 56 | fi 57 | 58 | if [ $# -gt 0 ];then 59 | # Execute CMD 60 | exec "$@" 61 | else 62 | # 63 | # Handle key dump import if available and no KDB 64 | # 65 | if ! test -d KDB; then 66 | if [ -d /data/dump ] && [ "$(echo /data/dump/*.pgp)" != "/data/dump/*.pgp" ]; then 67 | echo "=== Running build... ===" 68 | if ! sks build /data/dump/*.pgp -n ${SKS_INIT_BUILD_FILES} -cache ${SKS_INIT_BUILD_CACHE} -stdoutlog; then rm -rf KDB; fail; fi 69 | echo "=== Cleaning key database... ===" 70 | if ! sks cleandb -stdoutlog; then fail; fi 71 | fi 72 | fi 73 | if ! test -d PTree; then 74 | echo "=== Building ptree database... ===" 75 | if ! sks pbuild -cache ${SKS_INIT_PBUILD_CACHE} -ptree_cache ${SKS_INIT_PTREE_CACHE} -stdoutlog; then rm -rf PTree; fail; fi 76 | echo "=== Done! ===" 77 | fi 78 | 79 | # Start daemons 80 | exec /init 81 | fi -------------------------------------------------------------------------------- /patches/poison-key.diff: -------------------------------------------------------------------------------- 1 | diff -u sks-1.1.6.orig/keydb.ml sks-1.1.6/keydb.ml 2 | --- sks-1.1.6.orig/keydb.ml 2015-10-31 12:45:21.000000000 -0400 3 | +++ sks-1.1.6/keydb.ml 2020-10-18 17:04:18.877460100 -0400 4 | @@ -1166,29 +1166,38 @@ 5 | try 6 | if has_hash hash then [] else 7 | let keyid = Fingerprint.keyid_from_key ~short:true key in 8 | - let potential_merges = List.filter ~f:(fun x -> x <> key) 9 | - (get_by_short_keyid keyid) 10 | - in 11 | - plerror 4 "%d potential merges found for keyid %s" 12 | - (List.length potential_merges) (KeyHash.hexify keyid); 13 | - let (deletions,mergedkey) = 14 | - List.fold_left ~init:([],key) potential_merges 15 | - ~f:(fun (updates,key) x -> 16 | - match KeyMerge.merge key x with 17 | - | None -> (updates,key) 18 | - | Some mergedkey -> 19 | - ((x, DeleteKey)::updates, 20 | - mergedkey) 21 | - ) 22 | - in 23 | - let addition = (mergedkey,AddKey) in 24 | - let updates = addition::deletions in 25 | - let updates = List.rev updates in 26 | - let updates = List.map updates 27 | - ~f:(fun (key,action) -> (key_to_metadata key,action)) 28 | - in 29 | - plerror 4 "%d updates found before filtering" (List.length updates); 30 | - updates 31 | + let keyid_long = Fingerprint.keyid_to_string ~short:false (Fingerprint.keyid_from_key ~short:false key) in 32 | + 33 | + (* Blacklist poison key - RT#112669 *) 34 | + plerror 4 "considering keyid %s" keyid_long; 35 | + if List.mem keyid_long [ 36 | + "E41ED3A107A7DBC7"; (* 2018-07-16 *) 37 | + "86CE877469D2EAD9"; (* 2019-01-22 *) 38 | + "73E287A82CF1B349"; (* 2020-09-18 *) 39 | + ] then [] else 40 | + let potential_merges = List.filter ~f:(fun x -> x <> key) 41 | + (get_by_short_keyid keyid) 42 | + in 43 | + plerror 4 "%d potential merges found for keyid %s (%s)" 44 | + (List.length potential_merges) (KeyHash.hexify keyid) keyid_long; 45 | + let (deletions,mergedkey) = 46 | + List.fold_left ~init:([],key) potential_merges 47 | + ~f:(fun (updates,key) x -> 48 | + match KeyMerge.merge key x with 49 | + | None -> (updates,key) 50 | + | Some mergedkey -> 51 | + ((x, DeleteKey)::updates, 52 | + mergedkey) 53 | + ) 54 | + in 55 | + let addition = (mergedkey,AddKey) in 56 | + let updates = addition::deletions in 57 | + let updates = List.rev updates in 58 | + let updates = List.map updates 59 | + ~f:(fun (key,action) -> (key_to_metadata key,action)) 60 | + in 61 | + plerror 4 "%d updates found before filtering" (List.length updates); 62 | + updates 63 | with 64 | | Sys.Break | Eventloop.SigAlarm as e -> raise e 65 | | Bdb.DBError s as e -> 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SKS OpenPGP Keyserver 2 | 3 | ## Intro 4 | 5 | This is a containerized [SKS OpenPGP Keyserver][1] using [s6-overlay][2] on an 6 | [Alpine Linux][3] base image. 7 | 8 | Including improvements based on [Óscar García Amor][4] and [Martin Dobrev][5] 9 | derived forks of this repository. 10 | 11 | ## Guide 12 | 13 | The `/var/lib/sks` volume holds the key database, membership and sksconf files 14 | which should be mounted from a persistent storage source. 15 | 16 | The container provides 4 long-running services under s6 supervision: 17 | 18 | - `sks-db` - primary dependent service that terminates the container if it crashes 19 | - `sks-recon` - SKS gossip peering process which only starts after `sks-db` 20 | - `sks-stats` - generate DB statistics once an half hour by sending `sks-db` a USR2 signal 21 | - `sks-log-clean` - execute db_archive against key and PTree databases 2 hours 22 | 23 | ## Setup 24 | 25 | ### Configuration 26 | 27 | The `entrypoint.sh` script will make use of the following environment variables 28 | to setup the default `sksconf` config file and modify on restarts unless altered 29 | manually to no longer make use of the environment variables. 30 | 31 | | Variable | Default value | 32 | | --------------------- | ------------- | 33 | | SKS_HOSTNAME | localhost | 34 | | SKS_RECON_ADDR | 0.0.0.0 | 35 | | SKS_RECON_PORT | 11370 | 36 | | SKS_HKP_ADRESS | 0.0.0.0 | 37 | | SKS_HKP_PORT | 11371 | 38 | | SKS_SERVER_CONTACT | | 39 | | SKS_NODENAME | keys | 40 | | SKS_COMMAND_TIMEOUT | 600 | 41 | | SKS_WSERVER_TIMEOUT | 30 | 42 | | SKS_MAX_RECOVER | 150 | 43 | | SKS_INIT_BUILD_FILES | 10 | 44 | | SKS_INIT_BUILD_CACHE | 100 | 45 | | SKS_INIT_PBUILD_CACHE | 20 | 46 | | SKS_INIT_PTREE_CACHE | 70 | 47 | 48 | While other configuration options are available they are not managed at this 49 | time and would require editing the `sksconf` file directly. 50 | 51 | ### Storage 52 | 53 | The default persistent storage volume needed should be mounted to 54 | `/var/lib/sks` and will store the key (KDB) and ptree (PTree) databases along 55 | with the `sksconf`, `membership` and `DB_CONFIG` files. 56 | 57 | If a keydump volume is mounted to `/data/dump` to the container and the key and 58 | ptree databases do not yet exist, the `entrypoint.sh` will begin the database 59 | build process automatically. The choice of path was made to ensure it was outside 60 | the normal SKS basedir path so as not to be opened upon restart if the database 61 | already exists and the mount has not been removed. Once the keydump has been imported 62 | this mount volume could be removed as it is only necessary for initial import. 63 | 64 | ### Keydump 65 | 66 | To be of much use the SKS keyserver requires an initial dump of the available 67 | keys to be imported. As the version of `wget` available within [Alpine Linux][2] 68 | does not fully support the necessary options to mirror a keydump source, an 69 | additional [Debian][6] base image has been made available in the `keydump` 70 | directory of this repostory. 71 | 72 | This may be built using the following: 73 | 74 | ```shell 75 | docker build -t sks-keydump -f keydump/Dockerfile keydump/ 76 | ``` 77 | 78 | This image takes an optional environment variable of `KEYDUMP_URL` which 79 | defaults to [cyberbits.eu][7] but can be pointed to any web accessible URL to 80 | retrieve from. 81 | 82 | Use of this is completely optional but can make retrieving an initial keydump 83 | relatively simple to populate a volume that can then be mounted to the SKS container 84 | for import. 85 | 86 | ### Run 87 | 88 | [1]: https://github.com/SKS-Keyserver/sks-keyserver 89 | [2]: http://alpinelinux.org 90 | [3]: https://github.com/just-containers/s6-overlay 91 | [4]: https://github.com/ogarcia/docker-sks 92 | [5]: https://github.com/mclueppers/docker-sks 93 | [6]: https://www.debian.org/ 94 | [7]: https://mirror.cyberbits.eu/sks/dump/ 95 | -------------------------------------------------------------------------------- /patches/fix-build-failure.diff: -------------------------------------------------------------------------------- 1 | diff -u sks-1.1.6.orig/eventloop.ml sks-1.1.6/eventloop.ml 2 | --- sks-1.1.6.orig/eventloop.ml 2013-12-09 20:20:10.000000000 -0500 3 | +++ sks-1.1.6/eventloop.ml 2020-10-16 02:15:20.964893900 -0400 4 | @@ -26,6 +26,7 @@ 5 | open Printf 6 | open Common 7 | open Packet 8 | +let unix_socket = Unix.socket 9 | module Unix = UnixLabels 10 | open Unix 11 | 12 | @@ -129,7 +130,7 @@ 13 | let domain = 14 | Unix.domain_of_sockaddr addr in 15 | let sock = 16 | - socket ~domain ~kind:SOCK_STREAM ~protocol:0 in 17 | + unix_socket domain SOCK_STREAM 0 in 18 | setsockopt sock SO_REUSEADDR true; 19 | if domain = PF_INET6 then 20 | setsockopt sock IPV6_ONLY true; 21 | diff -u sks-1.1.6.orig/reconComm.ml sks-1.1.6/reconComm.ml 22 | --- sks-1.1.6.orig/reconComm.ml 2013-11-14 15:29:13.000000000 -0500 23 | +++ sks-1.1.6/reconComm.ml 2020-10-16 02:15:21.003911900 -0400 24 | @@ -26,6 +26,7 @@ 25 | open Common 26 | open Packet 27 | 28 | +let unix_socket = Unix.socket 29 | module Unix = UnixLabels 30 | module Map = PMap.Map 31 | 32 | @@ -37,10 +38,10 @@ 33 | 34 | (** send DbMessages message and wait for response *) 35 | let send_dbmsg msg = 36 | - let s = Unix.socket 37 | - ~domain:(Unix.domain_of_sockaddr db_command_addr) 38 | - ~kind:Unix.SOCK_STREAM 39 | - ~protocol:0 in 40 | + let s = unix_socket 41 | + (Unix.domain_of_sockaddr db_command_addr) 42 | + Unix.SOCK_STREAM 43 | + 0 in 44 | protect ~f:(fun () -> 45 | Unix.connect s ~addr:db_command_addr; 46 | let cin = Channel.sys_in_from_fd s in 47 | @@ -54,10 +55,10 @@ 48 | 49 | (** send DbMessages message, don't wait for response *) 50 | let send_dbmsg_noreply msg = 51 | - let s = Unix.socket 52 | - ~domain:(Unix.domain_of_sockaddr db_command_addr) 53 | - ~kind:Unix.SOCK_STREAM 54 | - ~protocol:0 in 55 | + let s = unix_socket 56 | + (Unix.domain_of_sockaddr db_command_addr) 57 | + Unix.SOCK_STREAM 58 | + 0 in 59 | protect ~f:(fun () -> 60 | Unix.connect s ~addr:db_command_addr; 61 | let cout = Channel.sys_out_from_fd s in 62 | @@ -75,10 +76,10 @@ 63 | let http_status_ok_regexp = Str.regexp "^HTTP/[0-9]+\\.[0-9]+ 2" 64 | 65 | let get_keystrings_via_http addr hashes = 66 | - let s = Unix.socket 67 | - ~domain:(Unix.domain_of_sockaddr addr) 68 | - ~kind:Unix.SOCK_STREAM 69 | - ~protocol:0 in 70 | + let s = unix_socket 71 | + (Unix.domain_of_sockaddr addr) 72 | + Unix.SOCK_STREAM 73 | + 0 in 74 | protect ~f:(fun () -> 75 | Unix.bind s ~addr:(match_client_recon_addr addr); 76 | Unix.connect s ~addr; 77 | diff -u sks-1.1.6.orig/sks_do.ml sks-1.1.6/sks_do.ml 78 | --- sks-1.1.6.orig/sks_do.ml 2013-11-14 15:29:13.000000000 -0500 79 | +++ sks-1.1.6/sks_do.ml 2020-10-16 02:15:21.026897200 -0400 80 | @@ -27,6 +27,7 @@ 81 | open Common 82 | open Packet 83 | open DbMessages 84 | +let unix_socket = Unix.socket 85 | module Unix = UnixLabels 86 | module PTree = PrefixTree 87 | module Map = PMap.Map 88 | @@ -37,10 +38,10 @@ 89 | exit (-1) 90 | 91 | let send_dbmsg msg = 92 | - let s = Unix.socket 93 | - ~domain:(Unix.domain_of_sockaddr db_command_addr) 94 | - ~kind:Unix.SOCK_STREAM 95 | - ~protocol:0 in 96 | + let s = unix_socket 97 | + (Unix.domain_of_sockaddr db_command_addr) 98 | + Unix.SOCK_STREAM 99 | + 0 in 100 | protect ~f:(fun () -> 101 | Unix.connect s ~addr:db_command_addr; 102 | let cin = Channel.sys_in_from_fd s in 103 | diff -u sks-1.1.6.orig/tester.ml sks-1.1.6/tester.ml 104 | --- sks-1.1.6.orig/tester.ml 2013-11-14 15:29:13.000000000 -0500 105 | +++ sks-1.1.6/tester.ml 2020-10-16 02:15:21.067896200 -0400 106 | @@ -26,6 +26,7 @@ 107 | open Common 108 | open Packet 109 | open DbMessages 110 | +let unix_socket = Unix.socket 111 | module Unix = UnixLabels 112 | 113 | let settings = { 114 | @@ -46,10 +47,10 @@ 115 | 116 | 117 | let send_msg addr msg = 118 | - let s = Unix.socket 119 | - ~domain:(Unix.domain_of_sockaddr addr) 120 | - ~kind:Unix.SOCK_STREAM 121 | - ~protocol:0 in 122 | + let s = unix_socket 123 | + (Unix.domain_of_sockaddr addr) 124 | + Unix.SOCK_STREAM 125 | + 0 in 126 | protect ~f:( fun () -> 127 | Unix.connect s ~addr:addr; 128 | let cin = Channel.sys_in_from_fd s 129 | @@ -62,10 +63,10 @@ 130 | ~finally:(fun () -> Unix.close s) 131 | 132 | let send_msg_noreply addr msg = 133 | - let s = Unix.socket 134 | - ~domain:(Unix.domain_of_sockaddr addr) 135 | - ~kind:Unix.SOCK_STREAM 136 | - ~protocol:0 in 137 | + let s = unix_socket 138 | + (Unix.domain_of_sockaddr addr) 139 | + Unix.SOCK_STREAM 140 | + 0 in 141 | protect ~f:(fun () -> 142 | Unix.connect s ~addr:addr; 143 | let cout = Channel.sys_out_from_fd s in 144 | -------------------------------------------------------------------------------- /patches/deprecated-ocaml.diff: -------------------------------------------------------------------------------- 1 | diff -u sks-1.1.6.orig/add_mail.ml sks-1.1.6/add_mail.ml 2 | --- sks-1.1.6.orig/add_mail.ml 2013-11-14 15:29:13.000000000 -0500 3 | +++ sks-1.1.6/add_mail.ml 2020-10-16 02:30:45.797056200 -0400 4 | @@ -54,7 +54,7 @@ 5 | (** dumps contents of one file into another *) 6 | let pipe_file = 7 | let blocksize = 100 * 1024 in 8 | - let buf = String.create blocksize in 9 | + let buf = Bytes.create blocksize in 10 | let rec pipe_file file1 file2 = 11 | let bytes_read = input file1 buf 0 blocksize in 12 | if bytes_read <> 0 then ( 13 | Common subdirectories: sks-1.1.6.orig/bdb and sks-1.1.6/bdb 14 | diff -u sks-1.1.6.orig/bitstring.ml sks-1.1.6/bitstring.ml 15 | --- sks-1.1.6.orig/bitstring.ml 2013-11-14 15:29:13.000000000 -0500 16 | +++ sks-1.1.6/bitstring.ml 2020-10-16 02:30:45.814049300 -0400 17 | @@ -40,7 +40,7 @@ 18 | let create bits = 19 | let bytes = bytelength bits 20 | in 21 | - { a = String.create bytes; 22 | + { a = Bytes.create bytes; 23 | bitlength = bits; 24 | } 25 | 26 | @@ -58,7 +58,7 @@ 27 | let intval = int_of_char (String.get ba.a byte_pos) in 28 | let new_char = char_of_int ((1 lsl (width - bit_pos - 1)) lxor intval) 29 | in 30 | - String.set ba.a byte_pos new_char 31 | + Bytes.set ba.a byte_pos new_char 32 | 33 | let set ba bit = 34 | let byte_pos = bit / width 35 | @@ -66,7 +66,7 @@ 36 | let intval = int_of_char (String.get ba.a byte_pos) in 37 | let new_char = char_of_int ((1 lsl (width - bit_pos - 1)) lor intval) 38 | in 39 | - String.set ba.a byte_pos new_char 40 | + Bytes.set ba.a byte_pos new_char 41 | 42 | let unset ba bit = 43 | let byte_pos = bit / width 44 | @@ -75,7 +75,7 @@ 45 | let new_char = char_of_int ((lnot (1 lsl (width - bit_pos - 1))) 46 | land intval) 47 | in 48 | - String.set ba.a byte_pos new_char 49 | + Bytes.set ba.a byte_pos new_char 50 | 51 | let setval ba bit bool = 52 | if bool then set ba bit else unset ba bit 53 | @@ -98,9 +98,9 @@ 54 | Array.init ~f:(fun i -> lget ba i) ba.bitlength 55 | 56 | let to_string ba = 57 | - let string = String.create ba.bitlength in 58 | + let string = Bytes.create ba.bitlength in 59 | for i = 0 to ba.bitlength -1 do 60 | - if get ba i = 0 then string.[i] <- '0' else string.[i] <- '1' 61 | + if get ba i = 0 then Bytes.set string i '0' else Bytes.set string i '1' 62 | done; 63 | string 64 | 65 | @@ -160,7 +160,7 @@ 66 | *) 67 | let copy_len ba bitlength = 68 | let bytes = bytelength bitlength in 69 | - let str = String.create bytes in 70 | + let str = Bytes.create bytes in 71 | String.blit ~src:ba.a ~src_pos:0 72 | ~dst:str ~dst_pos:0 ~len:(String.length ba.a); 73 | { a = str; bitlength = bitlength } 74 | @@ -191,17 +191,17 @@ 75 | if bits > 0 then 76 | let bytes = bytelength ba.bitlength in 77 | for i = 0 to bytes-2 do 78 | - ba.a.[i] <- shift_pair_left ba.a.[i] ba.a.[i+1] bits 79 | + Bytes.set ba.a i (shift_pair_left ba.a.[i] ba.a.[i+1] bits) 80 | done; 81 | - ba.a.[bytes-1] <- shift_pair_left ba.a.[bytes-1] '\000' bits 82 | + Bytes.set ba.a (bytes-1) (shift_pair_left ba.a.[bytes-1] '\000' bits) 83 | 84 | let shift_right_small ba bits = 85 | if bits > 0 then 86 | let bytes = bytelength ba.bitlength in 87 | for i = bytes-1 downto 1 do 88 | - ba.a.[i] <- shift_pair_right ba.a.[i-1] ba.a.[i] bits 89 | + Bytes.set ba.a i (shift_pair_right ba.a.[i-1] ba.a.[i] bits) 90 | done; 91 | - ba.a.[0] <- shift_pair_right '\000' ba.a.[0] bits 92 | + Bytes.set ba.a 0 (shift_pair_right '\000' ba.a.[0] bits) 93 | 94 | (**********************************) 95 | 96 | @@ -216,10 +216,10 @@ 97 | then 98 | begin 99 | for i = 0 to bytelength - 1 - bytes do 100 | - ba.a.[i] <- ba.a.[i+bytes]; 101 | + Bytes.set ba.a i ba.a.[i+bytes]; 102 | done; 103 | for i = bytelength - bytes to bytelength - 1 do 104 | - ba.a.[i] <- '\000' 105 | + Bytes.set ba.a i '\000' 106 | done 107 | end; 108 | shift_left_small ba bits 109 | @@ -235,10 +235,10 @@ 110 | then 111 | begin 112 | for i = bytelength - 1 downto bytes do 113 | - ba.a.[i] <- ba.a.[i-bytes]; 114 | + Bytes.set ba.a i ba.a.[i-bytes]; 115 | done; 116 | for i = bytes - 1 downto 0 do 117 | - ba.a.[i] <- '\000' 118 | + Bytes.set ba.a i '\000' 119 | done 120 | end; 121 | shift_right_small ba bits 122 | @@ -275,14 +275,14 @@ 123 | let newdst = (rmasks.(bitlen) land srcval) lor 124 | ((lnot rmasks.(bitlen)) land dstval) 125 | in 126 | - dst.a.[bytelen] <- char_of_int newdst 127 | + Bytes.set dst.a bytelen (char_of_int newdst) 128 | 129 | 130 | (* let full_blit ~src ~src_pos ~dst ~dst_pos ~len = *) 131 | 132 | 133 | let zero_out bs = 134 | - String.fill bs.a ~pos:0 ~len:(String.length bs.a) '\000' 135 | + Bytes.fill bs.a ~pos:0 ~len:(String.length bs.a) '\000' 136 | 137 | (* 138 | let extract bs ~pos ~len = 139 | diff -u sks-1.1.6.orig/channel.ml sks-1.1.6/channel.ml 140 | --- sks-1.1.6.orig/channel.ml 2013-11-14 15:29:13.000000000 -0500 141 | +++ sks-1.1.6/channel.ml 2020-10-16 02:30:45.820050200 -0400 142 | @@ -50,7 +50,7 @@ 143 | let string = 144 | match !stringopt with 145 | None -> 146 | - let string = String.create len in 147 | + let string = Bytes.create len in 148 | stringopt := Some string; 149 | pos := 0; 150 | string 151 | @@ -125,7 +125,7 @@ 152 | None -> 1024 * 100 153 | | Some x -> x 154 | in 155 | - let sbuf = String.create len 156 | + let sbuf = Bytes.create len 157 | and buf = Buffer.create len in 158 | read_all_rec cin sbuf buf; 159 | Buffer.contents buf 160 | @@ -167,7 +167,7 @@ 161 | method virtual read_string_pos : buf:string -> pos:int -> len:int -> unit 162 | method virtual read_char : char 163 | method read_string len = 164 | - let buf = String.create len in 165 | + let buf = Bytes.create len in 166 | self#read_string_pos ~buf ~pos:0 ~len; 167 | buf 168 | method read_byte = int_of_char self#read_char 169 | diff -u sks-1.1.6.orig/dbserver.ml sks-1.1.6/dbserver.ml 170 | --- sks-1.1.6.orig/dbserver.ml 2014-03-08 11:05:53.000000000 -0500 171 | +++ sks-1.1.6/dbserver.ml 2020-10-16 02:30:45.843058200 -0400 172 | @@ -396,7 +396,7 @@ 173 | let f = (if binary then open_in_bin else open_in) fname in 174 | protect ~f:(fun () -> 175 | let length = in_channel_length f in 176 | - let buf = String.create length in 177 | + let buf = Bytes.create length in 178 | really_input f buf 0 length; 179 | buf 180 | ) 181 | diff -u sks-1.1.6.orig/heap.ml sks-1.1.6/heap.ml 182 | --- sks-1.1.6.orig/heap.ml 2013-11-14 15:29:13.000000000 -0500 183 | +++ sks-1.1.6/heap.ml 2020-10-16 02:30:45.849052900 -0400 184 | @@ -146,7 +146,7 @@ 185 | (***************************************************************) 186 | 187 | let empty cmp i = 188 | - { a = Array.create i None; 189 | + { a = Array.make i None; 190 | length = 0; 191 | minsize = i; 192 | cmp = cmp; 193 | diff -u sks-1.1.6.orig/keyHash.ml sks-1.1.6/keyHash.ml 194 | --- sks-1.1.6.orig/keyHash.ml 2013-11-14 15:29:13.000000000 -0500 195 | +++ sks-1.1.6/keyHash.ml 2020-10-16 02:30:45.864061100 -0400 196 | @@ -73,11 +73,11 @@ 197 | 198 | let dehexify s = 199 | let s = String.uppercase s in 200 | - let ns = String.create (String.length s / 2) in (* new string *) 201 | + let ns = Bytes.create (String.length s / 2) in (* new string *) 202 | for i = 0 to String.length ns - 1 do 203 | let first = hexchar_to_int s.[2 * i] 204 | and second = hexchar_to_int s.[2 * i + 1] 205 | in 206 | - ns.[i] <- char_of_int ((first lsl 4) + second) 207 | + Bytes.set ns i (char_of_int ((first lsl 4) + second)) 208 | done; 209 | ns 210 | diff -u sks-1.1.6.orig/linearAlg.ml sks-1.1.6/linearAlg.ml 211 | --- sks-1.1.6.orig/linearAlg.ml 2013-11-14 15:29:13.000000000 -0500 212 | +++ sks-1.1.6/linearAlg.ml 2020-10-16 02:30:45.874070800 -0400 213 | @@ -62,7 +62,7 @@ 214 | let copy m = { m with array = Array.copy m.array; } 215 | 216 | let make ~columns ~rows init = 217 | - let array = Array.create (columns * rows) init in 218 | + let array = Array.make (columns * rows) init in 219 | { columns = columns; 220 | rows = rows; 221 | array = array; 222 | diff -u sks-1.1.6.orig/mList.ml sks-1.1.6/mList.ml 223 | --- sks-1.1.6.orig/mList.ml 2013-11-14 15:29:13.000000000 -0500 224 | +++ sks-1.1.6/mList.ml 2020-10-16 02:30:45.891057000 -0400 225 | @@ -200,7 +200,7 @@ 226 | (low,exact,high) 227 | 228 | let has_dups list = 229 | - let slist = Sort.list (fun x y -> x < y) list in 230 | + let slist = List.sort compare list in 231 | let rec dup_scan list = match list with 232 | [] -> false 233 | | hd::[] -> false 234 | @@ -208,7 +208,7 @@ 235 | in dup_scan slist 236 | 237 | let dedup list = 238 | - let slist = Sort.list (fun x y -> x < y) list in 239 | + let slist = List.sort compare list in 240 | let rec dedup ~list ~partial = match list with 241 | [] -> partial 242 | | hd::[] -> dedup ~list:[] ~partial:(hd::partial) 243 | diff -u sks-1.1.6.orig/number.ml sks-1.1.6/number.ml 244 | --- sks-1.1.6.orig/number.ml 2013-11-14 15:29:13.000000000 -0500 245 | +++ sks-1.1.6/number.ml 2020-10-16 02:30:45.920064400 -0400 246 | @@ -60,9 +60,9 @@ 247 | 248 | let revstring s = 249 | let len = String.length s in 250 | - let copy = String.create len in 251 | + let copy = Bytes.create len in 252 | for i = 0 to len - 1 do 253 | - copy.[i] <- s.[len - 1 - i] 254 | + Bytes.set copy i s.[len - 1 - i] 255 | done; 256 | copy 257 | 258 | @@ -71,19 +71,19 @@ 259 | for i = 0 to (len - 2)/2 do 260 | let j = len - 1 - i in 261 | let tmp = s.[i] in 262 | - s.[i] <- s.[j]; 263 | - s.[j] <- tmp 264 | + Bytes.set s i s.[j]; 265 | + Bytes.set s j tmp 266 | done 267 | 268 | let to_bytes ~nbytes n = 269 | if sign_big_int n = -1 270 | then raise (Invalid_argument "N.to_bytes: negative argument"); 271 | - let string = String.create nbytes in 272 | + let string = Bytes.create nbytes in 273 | let rec loop n i = 274 | if i < 0 then string 275 | else 276 | let (a,b) = quomod_big_int n width_pow in 277 | - string.[i] <- char_of_int (int_of_big_int b); 278 | + Bytes.set string i (char_of_int (int_of_big_int b)); 279 | loop a (i - 1) 280 | in 281 | let str = loop n (nbytes - 1) in 282 | diff -u sks-1.1.6.orig/prefixTree.ml sks-1.1.6/prefixTree.ml 283 | --- sks-1.1.6.orig/prefixTree.ml 2013-11-14 15:29:13.000000000 -0500 284 | +++ sks-1.1.6/prefixTree.ml 2020-10-16 02:30:45.937059400 -0400 285 | @@ -730,8 +730,8 @@ 286 | let pad string bytes = 287 | let len = String.length string in 288 | if bytes > len then 289 | - let nstr = String.create bytes in 290 | - String.fill nstr ~pos:len ~len:(bytes - len) '\000'; 291 | + let nstr = Bytes.create bytes in 292 | + Bytes.fill nstr ~pos:len ~len:(bytes - len) '\000'; 293 | String.blit ~src:string ~dst:nstr ~src_pos:0 ~dst_pos:0 ~len; 294 | nstr 295 | else 296 | diff -u sks-1.1.6.orig/rMisc.ml sks-1.1.6/rMisc.ml 297 | --- sks-1.1.6.orig/rMisc.ml 2013-11-14 15:29:13.000000000 -0500 298 | +++ sks-1.1.6/rMisc.ml 2020-10-16 02:30:45.953059700 -0400 299 | @@ -56,15 +56,15 @@ 300 | (* CR yminsky: I think this has the same bug as the function with the same name in Utils *) 301 | let _bits = rfunc () in 302 | for i = 0 to steps - 1 do 303 | - string.[pos + i] <- 304 | - char_of_int (0xFF land ((rfunc ()) lsr (8 * i))) 305 | + Bytes.set string (pos + i) 306 | + (char_of_int (0xFF land ((rfunc ()) lsr (8 * i)))) 307 | done; 308 | fill_random_string rfunc string ~pos:(pos + steps) ~len 309 | else 310 | () 311 | 312 | let random_string rfunc len = 313 | - let string = String.create len in 314 | + let string = Bytes.create len in 315 | fill_random_string rfunc string ~pos:0 ~len; 316 | string 317 | 318 | @@ -124,8 +124,8 @@ 319 | let pad string bytes = 320 | let len = String.length string in 321 | if bytes > len then 322 | - let nstr = String.create bytes in 323 | - String.fill nstr ~pos:len ~len:(bytes - len) '\000'; 324 | + let nstr = Bytes.create bytes in 325 | + Bytes.fill nstr ~pos:len ~len:(bytes - len) '\000'; 326 | String.blit ~src:string ~dst:nstr ~src_pos:0 ~dst_pos:0 ~len; 327 | nstr 328 | else 329 | @@ -139,7 +139,7 @@ 330 | let truncate string bytes = 331 | let len = String.length string in 332 | if bytes < len then 333 | - let nstr = String.create bytes in 334 | + let nstr = Bytes.create bytes in 335 | String.blit ~src:string ~dst:nstr ~src_pos:0 ~dst_pos:0 ~len:bytes; 336 | nstr 337 | else 338 | @@ -160,7 +160,7 @@ 339 | (** Printing Functions *) 340 | 341 | let print_ZZp_list list = 342 | - let list = Sort.list (fun x y -> compare x y < 0) list in 343 | + let list = List.sort compare list in 344 | MList.print2 ~f:ZZp.print list 345 | 346 | let print_ZZp_set set = print_ZZp_list (Set.elements set) 347 | Common subdirectories: sks-1.1.6.orig/sampleConfig and sks-1.1.6/sampleConfig 348 | Common subdirectories: sks-1.1.6.orig/sampleWeb and sks-1.1.6/sampleWeb 349 | diff -u sks-1.1.6.orig/utils.ml sks-1.1.6/utils.ml 350 | --- sks-1.1.6.orig/utils.ml 2013-11-14 15:29:13.000000000 -0500 351 | +++ sks-1.1.6/utils.ml 2020-10-16 02:30:45.972056400 -0400 352 | @@ -173,12 +173,12 @@ 353 | let char_width = 8 354 | 355 | let hexstring digest = 356 | - let result = String.create (String.length digest * 2) in 357 | - let hex = "0123456789ABCDEF" in 358 | + let result = Bytes.create (String.length digest * 2) in 359 | + let hex = Bytes.of_string "0123456789ABCDEF" in 360 | for i = 0 to String.length digest - 1 do 361 | let c = Char.code digest.[i] in 362 | - result.[2*i] <- hex.[c lsr 4]; 363 | - result.[2*i+1] <- hex.[c land 0xF] 364 | + Bytes.set result (2*i) hex.[c lsr 4]; 365 | + Bytes.set result (2*i+1) hex.[c land 0xF] 366 | done; 367 | result 368 | 369 | @@ -192,11 +192,11 @@ 370 | int_from_bstring_rec string ~pos ~len 0 371 | 372 | let bstring_of_int i = 373 | - let s = String.create 4 in 374 | - s.[3] <- char_of_int (i land 0xFF); 375 | - s.[2] <- char_of_int ((i lsr 8) land 0xFF); 376 | - s.[1] <- char_of_int ((i lsr 16) land 0xFF); 377 | - s.[0] <- char_of_int ((i lsr 24) land 0xFF); 378 | + let s = Bytes.create 4 in 379 | + Bytes.set s 3 (char_of_int (i land 0xFF)); 380 | + Bytes.set s 2 (char_of_int ((i lsr 8) land 0xFF)); 381 | + Bytes.set s 1 (char_of_int ((i lsr 16) land 0xFF)); 382 | + Bytes.set s 0 (char_of_int ((i lsr 24) land 0xFF)); 383 | s 384 | 385 | (* tail recursive *) 386 | @@ -265,15 +265,15 @@ 387 | the random generation being deterministic *) 388 | let _bits = rfunc () in 389 | for i = 0 to steps - 1 do 390 | - string.[pos + i] <- 391 | - char_of_int (0xFF land ((rfunc ()) lsr (8 * i))) 392 | + Bytes.set string (pos + i) 393 | + (char_of_int (0xFF land ((rfunc ()) lsr (8 * i)))) 394 | done; 395 | fill_random_string rfunc string ~pos:(pos + steps) ~len 396 | else 397 | () 398 | 399 | let random_string rfunc len = 400 | - let string = String.create len in 401 | + let string = Bytes.create len in 402 | fill_random_string rfunc string ~pos:0 ~len; 403 | string 404 | 405 | diff -u sks-1.1.6.orig/wserver.ml sks-1.1.6/wserver.ml 406 | --- sks-1.1.6.orig/wserver.ml 2014-05-03 15:16:02.000000000 -0400 407 | +++ sks-1.1.6/wserver.ml 2020-10-16 02:30:45.988059200 -0400 408 | @@ -75,9 +75,9 @@ 409 | match s.[i] with 410 | '%' when i + 2 < String.length s -> 411 | let v = hexa_val s.[i + 1] * 16 + hexa_val s.[i + 2] in 412 | - s1.[i1] <- Char.chr v; i + 3 413 | - | '+' -> s1.[i1] <- ' '; succ i 414 | - | x -> s1.[i1] <- x; succ i 415 | + Bytes.set s1 i1 (Char.chr v); i + 3 416 | + | '+' -> Bytes.set s1 i1 ' '; succ i 417 | + | x -> Bytes.set s1 i1 x; succ i 418 | in 419 | copy_decode_in s1 i (succ i1) 420 | else s1 421 | @@ -95,7 +95,7 @@ 422 | in 423 | if need_decode 0 then 424 | let len = compute_len 0 0 in 425 | - let s1 = String.create len in 426 | + let s1 = Bytes.create len in 427 | strip_heading_and_trailing_spaces (copy_decode_in s1 0 0) 428 | else s 429 | 430 | @@ -120,22 +120,22 @@ 431 | if i < String.length s then 432 | let i1 = 433 | match s.[i] with 434 | - ' ' -> s1.[i1] <- '+'; succ i1 435 | + ' ' -> Bytes.set s1 i1 '+'; succ i1 436 | | c -> 437 | if special c then 438 | begin 439 | - s1.[i1] <- '%'; 440 | - s1.[i1 + 1] <- hexa_digit (Char.code c / 16); 441 | - s1.[i1 + 2] <- hexa_digit (Char.code c mod 16); 442 | + Bytes.set s1 i1 '%'; 443 | + Bytes.set s1 (i1 + 1) (hexa_digit (Char.code c / 16)); 444 | + Bytes.set s1 (i1 + 2) (hexa_digit (Char.code c mod 16)); 445 | i1 + 3 446 | end 447 | - else begin s1.[i1] <- c; succ i1 end 448 | + else begin Bytes.set s1 i1 c; succ i1 end 449 | in 450 | copy_code_in s1 (succ i) i1 451 | else s1 452 | in 453 | if need_code 0 then 454 | - let len = compute_len 0 0 in copy_code_in (String.create len) 0 0 455 | + let len = compute_len 0 0 in copy_code_in (Bytes.create len) 0 0 456 | else s 457 | 458 | let stripchars = Set.of_list [ ' '; '\t'; '\n'; '\r' ] 459 | @@ -180,7 +180,7 @@ 460 | if len > max_post_length 461 | then raise (Entity_too_large (sprintf "POST data too long: %f megs" 462 | (float len /. 1024. /. 1024.))); 463 | - let rest = String.create len in 464 | + let rest = Bytes.create len in 465 | really_input cin rest 0 len; 466 | rest 467 | with 468 | --------------------------------------------------------------------------------