├── .gitignore ├── .gitlab-ci.yml ├── AUTHORS ├── Changelog ├── INSTALL.md ├── LICENSE.txt ├── Licence_CeCILL_V2-fr.txt ├── Makefile ├── Makefile.ocaml ├── Makefile.template ├── README.md ├── TODO ├── core ├── .gitignore ├── META ├── Makefile ├── asn1Engine.ml ├── asn1PTypes.ml ├── base64.ml ├── basePTypes.ml ├── crc.ml ├── getopt.ml ├── json.ml ├── pOutput.ml ├── pOutput.mli.TODO ├── pTypes.ml ├── parsifal.ml ├── protobuf.ml ├── test │ ├── .gitignore │ ├── Makefile │ ├── test_getopt.ml │ ├── test_parsifal.ml │ └── test_protobuf.ml ├── unit │ ├── .gitignore │ ├── Makefile │ ├── test_base64.ml │ ├── test_basePTypes.ml │ └── test_string_inputs.ml.TODO └── zLib.ml ├── crypto ├── .gitignore ├── META ├── Makefile ├── crl.ml ├── cryptoUtil.ml ├── dHKey.ml ├── dSAKey.ml ├── eCKey.ml ├── pkcs1.ml ├── pkcs7.ml ├── randomEngine.ml ├── test │ ├── .gitignore │ ├── Makefile │ └── test_random.ml ├── x509.ml ├── x509Basics.ml ├── x509CertificateStore.ml.TODO ├── x509Extensions.ml └── x509Util.ml ├── docker ├── build.sh ├── buster │ └── Dockerfile ├── mk_release.sh ├── opam2 │ └── Dockerfile └── release │ └── Dockerfile ├── docs ├── bgp │ ├── index.txt │ ├── rfc4271.txt │ ├── rfc4760.txt │ └── rfc6396.txt ├── camlp4 │ └── camlp4-AST.html ├── dex │ ├── dex-format.html │ ├── dex-format.url │ └── dex-format_files │ │ └── dex-format.css ├── dns │ └── rfc1035.txt ├── dvi │ └── tb06software.pdf ├── jpg │ ├── DC-008-2010_E.pdf │ ├── JPEG.pdf │ ├── JPGALGO.txt │ ├── Wallace.JPEG.pdf │ ├── itu-t81.pdf │ ├── jfif-1.pdf │ └── jpg.txt ├── krb │ ├── rfc3961.txt │ ├── rfc3962.txt │ ├── rfc4120.txt │ └── rfc4556.txt ├── png │ ├── libmich │ ├── rfc1950.txt │ ├── rfc1951.txt │ ├── rfc1952.txt │ └── rfc2083.txt ├── ssh │ ├── index.txt │ ├── rfc4250.txt │ ├── rfc4251.txt │ ├── rfc4252.txt │ ├── rfc4253.txt │ ├── rfc4254.txt │ └── rfc4255.txt └── tls │ ├── draft02.html │ ├── draft302.txt │ ├── index.txt │ ├── rfc2104.txt │ ├── rfc2246.txt │ ├── rfc2560.txt │ ├── rfc2712.txt │ ├── rfc3039.txt │ ├── rfc3218.txt │ ├── rfc3279.txt │ ├── rfc3280.txt │ ├── rfc3447.txt │ ├── rfc3546.txt │ ├── rfc3739.txt │ ├── rfc3749.txt │ ├── rfc4055.txt │ ├── rfc4162.txt │ ├── rfc4279.txt │ ├── rfc4346.txt │ ├── rfc4347.txt │ ├── rfc4366.txt │ ├── rfc4492.txt │ ├── rfc4507.txt │ ├── rfc4680.txt │ ├── rfc5054.txt │ ├── rfc5246.txt │ ├── rfc5280.txt │ ├── rfc5288.txt │ ├── rfc5289.txt │ ├── rfc5469.txt │ ├── rfc5487.txt │ ├── rfc5489.txt │ ├── rfc5746.txt │ ├── rfc5751.txt │ ├── rfc5932.txt │ ├── rfc6066.txt │ ├── rfc6091.txt │ ├── rfc6101.txt │ ├── rfc6125.txt │ ├── rfc6209.txt │ ├── rfc6347.txt │ ├── rfc6367.txt │ ├── rfc6520.txt │ ├── tls-extensiontype-values.xml │ └── tls-parameters.xml ├── formats ├── .gitignore ├── EfiTianoDecompress.c ├── EfiTianoDecompress.h ├── META ├── Makefile ├── basetypes.h ├── dex.ml.TODO ├── dvi.ml ├── guid.ml ├── lzma.ml ├── lzma.mli ├── lzma_stubs.c ├── pe.ml ├── png.ml ├── tar.ml ├── test │ ├── .gitignore │ ├── Makefile │ ├── test_dvi.ml │ ├── test_pe.ml │ ├── test_tar.ml │ └── test_uefi_fv.ml ├── tiano.ml ├── tiano.mli ├── tiano_stubs.c ├── uefi_fv.ml ├── unlzma.c └── unlzma.h ├── issues.txt ├── kerby ├── .gitignore ├── META ├── Makefile ├── kerberosTypes.ml ├── kerby.ml ├── kerbyContainers.ml ├── keytab.ml ├── krb5.h ├── krb5.ml ├── krb5.mli ├── krb5_functions.c ├── krb5_stubs.c ├── pac.ml ├── padata.ml └── test │ └── sample-des-rc4.keytab ├── lwt ├── .gitignore ├── META ├── Makefile ├── lwtUtil.ml ├── lwt_semaphore.ml └── lwt_semaphore.mli.TODO ├── mk_project.sh ├── net ├── .gitignore ├── META ├── Makefile ├── dns.ml ├── http.ml ├── libntp.ml ├── mrt.ml ├── pcap.ml ├── pcapContainers.ml └── test │ ├── .gitignore │ ├── Makefile │ ├── test_dns.ml │ └── test_mrt.ml ├── opam ├── openpgp-tools └── .gitignore ├── openpgp ├── .gitignore ├── META ├── Makefile └── libpgp.ml ├── papers └── Parsifal-paper--v0.1.pdf ├── parsifal.install ├── pci ├── .gitignore ├── Makefile ├── pci.ml └── test_pci.ml ├── prepare-release.sh ├── ssl-tools ├── .gitignore ├── Makefile ├── check_sslclient.ml.TODO ├── check_sslserver.ml.TODO ├── disturber.ml ├── extractSessions.ml ├── mapAnswers.ml ├── probe_server.ml ├── serveranswer.ml ├── sslproxy.ml ├── sslrevproxy.ml └── x509show.ml ├── ssl ├── .gitignore ├── META ├── Makefile ├── answerDump.ml ├── answerDumpUtil.ml ├── ocsp.ml.TODO ├── ssl2.ml ├── test │ ├── .gitignore │ ├── Makefile │ ├── test_ssl2.ml │ ├── test_tls_client.ml │ └── test_tls_server.ml ├── tls.ml ├── tlsCrypto.ml ├── tlsDatabase.ml ├── tlsEngineNG.ml ├── tlsEnums.ml └── unit │ ├── .gitignore │ ├── Makefile │ ├── test_prf.ml │ └── test_suites.ml ├── syntax ├── .gitignore ├── META ├── Makefile ├── parsifalHelpers.ml ├── parsifalSyntax.ml └── unit │ ├── Makefile │ ├── enum-01.ml │ ├── enum-01.out │ ├── enum-02.ml │ ├── enum-02.out │ ├── enum-03.ml │ ├── enum-03.out │ ├── enum-04.ml │ ├── enum-04.out │ ├── enum-05.ml │ ├── enum-05.out │ ├── enum-06.ml │ ├── enum-06.out │ ├── enum-07.ml │ ├── enum-07.out │ ├── enum-08.ml │ ├── enum-08.out │ ├── enum-09.ml │ ├── enum-09.out │ ├── enum-0a.ml │ ├── enum-0a.out │ ├── enum-0b.ml │ ├── enum-0b.out │ ├── enum-0c.ml │ ├── enum-0c.out │ ├── enum-0d.ml │ ├── enum-0d.out │ ├── enum-0e.ml │ ├── enum-0e.out │ ├── enum-0f.ml │ ├── enum-0f.out │ ├── enum-10.ml │ ├── enum-10.out │ ├── enum-11.ml │ ├── enum-11.out │ ├── enum-12.ml │ ├── enum-12.out │ ├── enum-13.ml │ ├── enum-13.out │ ├── enum-14.ml │ ├── enum-14.out │ ├── enum-15.ml │ ├── enum-15.out │ ├── enum-16.ml │ ├── enum-16.out │ ├── enum-17.ml │ ├── enum-17.out │ ├── enum.list │ ├── enum_test.ml │ ├── struct-01.ml │ ├── struct-01.out │ ├── struct-02.ml │ ├── struct-02.out │ ├── struct-03.ml │ ├── struct-03.out │ ├── struct-04.ml │ ├── struct-04.out │ ├── struct-05.ml │ ├── struct-05.out │ ├── struct-06.ml │ ├── struct-06.out │ ├── struct-07.ml │ ├── struct-07.out │ ├── struct-08.ml │ ├── struct-08.out │ ├── struct-09.ml │ ├── struct-09.out │ ├── struct-0a.ml │ ├── struct-0a.out │ ├── struct-0b.ml │ ├── struct-0b.out │ ├── struct-0c.ml │ ├── struct-0c.out │ ├── struct-0d.ml │ ├── struct-0d.out │ ├── struct-0e.ml │ ├── struct-0e.out │ ├── struct-0f.ml │ ├── struct-0f.out │ ├── struct-10.ml │ ├── struct-10.out │ ├── struct-11.ml │ ├── struct-11.out │ ├── struct-12.ml │ ├── struct-12.out │ ├── struct-13.ml │ ├── struct-13.out │ ├── struct-14.ml │ ├── struct-14.out │ ├── struct-15.ml │ ├── struct-15.out │ ├── struct-16.ml │ ├── struct-16.out │ └── struct.list ├── tools ├── .gitignore ├── Makefile ├── asn1parse.ml ├── parsifal_main.ml ├── picodig.ml └── test │ ├── https-secrets.txt │ ├── https.pcap │ ├── pcap-encrypted-tls-records.txt │ ├── pcap-tls-records.txt │ ├── tcp-raw-records.txt │ ├── tcp-records.txt │ ├── tls-decrypt-test.sh │ └── tls-records.txt ├── toplevel.ml ├── toplevel.sh ├── tutorial ├── .gitignore ├── 2014-03-01--tutorial.pdf ├── Makefile ├── csr-steps │ ├── .gitignore │ ├── Makefile │ ├── csr1.ml │ ├── csr2.ml │ └── csr3.ml ├── dns-steps │ ├── .gitignore │ ├── Makefile │ ├── dns1.ml │ ├── dns2.ml │ ├── dns3.ml │ ├── dns4.ml │ ├── dns5.ml │ ├── dns6.ml │ └── dns7.ml ├── examples │ ├── aliases.ml │ ├── asn1_dn.ml │ ├── enum_tls_version.ml │ ├── struct_tls_alert.ml │ └── union_bgp_as_path_segment.ml ├── index.html ├── png-steps │ ├── .gitignore │ ├── Makefile │ ├── png1.ml │ ├── png2.ml │ ├── png3.ml │ ├── png4.ml │ ├── png5.ml │ └── png6.ml ├── tar-steps │ ├── .gitignore │ ├── Makefile │ ├── tar1.ml │ ├── tar2.ml │ ├── tar3.ml │ ├── tar4.ml │ ├── tar5.ml │ ├── tar6.ml │ ├── tar7.ml │ ├── tar8.ml │ └── tar9.ml └── tutorial.tex └── usrlibocaml ├── parsifal_core ├── parsifal_crypto ├── parsifal_formats ├── parsifal_kerby ├── parsifal_lwt ├── parsifal_net ├── parsifal_pgp ├── parsifal_ssl └── parsifal_syntax /.gitignore: -------------------------------------------------------------------------------- 1 | data-samples 2 | stats 3 | *~ 4 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | stages: 2 | - test 3 | 4 | test-buster: 5 | image: pictyeye/parsifal-test:buster 6 | stage: test 7 | script: 8 | ./prepare-release.sh 9 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | == Parsifal developpers == 2 | 3 | Maintainer: Olivier Levillain 4 | 5 | Contributors: 6 | - Olivier Levillain (TLS, X.509, DNS) 7 | - Pierre Chifflier (PE, PKCS#7, UEFI) 8 | - Thomas Calderon (Kerberos) 9 | - Anthony Albert (PNG) 10 | - Florian Maury (OpenPGP, NTP) 11 | - Baptiste Gourdin (X.509 validation) 12 | 13 | Acknowledgement: 14 | - Pierre Chambart (OCamlPro) for OPAM metadata 15 | - Nicolas Vivet 16 | - Maxence Tury 17 | -------------------------------------------------------------------------------- /Changelog: -------------------------------------------------------------------------------- 1 | 2016-12-30 Olivier Levillain 2 | * Various bugfixes to make parsifal and concerto work 3 | on recent versions of the OCaml compiler. 4 | 5 | 2015-07-19 Baptiste Gourdin 6 | * New CRL PType. 7 | * First version of x509check tool (not commited 8 | in master branch, integration pending). 9 | 10 | 2014-11-07 Nicolas Vivet 11 | * Bugfix: correctly handle kerberos/heimdal on various 12 | systems. 13 | 14 | 2014-11-05 Olivier Levillain 15 | * Pkcs1.raw_verify security fix 16 | * Various bugfixes/improvements in tools 17 | * Bugfix: probe_server probe2dump leaked file 18 | descriptors. 19 | 20 | 2014-08-19 Pierre Chambart 21 | * Add first support for OPAM 22 | 23 | 2014-08-13 Olivier Levillain 24 | * Various crypto bugfixes 25 | * Add first support for record protection 26 | * Full rewrite of TlsEngineNG to handle Handshake 27 | up until Finished 28 | 29 | 2014-07-18 Olivier Levillain 30 | * Add name extraction to some tools (mapAnswers and 31 | x509show) 32 | 33 | 2014-06-03 Thomas Calderon 34 | * Add support for Keberos encrypted containers using 35 | libkrb5 36 | * First support for PK_INIT RSA decryption 37 | * Add support for ticket decryption in AP_REQ messages 38 | * Add support for some of Kerberos authorization data 39 | (PAC in particular) 40 | 41 | 2014-04-04 Florian Maury 42 | * First description of NTP messages 43 | * Add function to read input with read_line 44 | (1 line = 1 message) 45 | * Add output option to allow one-line JSON output format 46 | 47 | 2014-03-10 Olivier Levillain 48 | * Fixed some bugs in TlsEngineNG and how TLS records 49 | were parsed offline. 50 | 51 | 2014-02-27 Olivier Levillain 52 | * New step-by-step example: PKCS#10 CSR 53 | 54 | 2014-02-25 Olivier Levillain 55 | * Major rewrite of TLS engine (using automata) 56 | * Remove several programs to limit the number of targets 57 | * New library: crypto, to factor some code 58 | * Issue #6: Document the repo layout in README.md 59 | * Issue #20: Remove Lwt from most of the libs (only the 60 | ssl libs and some progs still use Lwt) 61 | 62 | 2014-02-17 Olivier Levillain 63 | * First implementation of gzip_container 64 | * New PTypes: (rtol_)bit_magic 65 | 66 | 2014-02-12 Olivier Levillain 67 | * Issue #15: Add string_input_of_stdin 68 | * Issue #13: Debug feature: handle name in containers 69 | * Issue #18 and #19: Add README and INSTALL files 70 | * First unit tests for the preprocessor 71 | * Remove Lwt as a specific input type 72 | 73 | 2014-01-22 Pierre Chifflier 74 | * Various bugfixes/enhancements 75 | * PE support improvements 76 | * First description of UEFI Volume formats 77 | 78 | 2014-01-21 Florian Maury 79 | * First description of OpenPGP messages 80 | 81 | 2014-01-20 Olivier Levillain 82 | * New helper in core: string_input_of_stdin 83 | 84 | 2014-01-20 Olivier Levillain 85 | * Issue #14: Improve debug info on parsing errors 86 | (the name used for a container is now the name of 87 | the struct field or the PType [union/alias]) 88 | 89 | 2014-01-15 Olivier Levillain 90 | * Issue #11: Allow for more flexible enum patterns 91 | (multiple and range patterns) 92 | 93 | 2014-01-11 Olivier Levillain 94 | * Initial Changelog 95 | -------------------------------------------------------------------------------- /INSTALL.md: -------------------------------------------------------------------------------- 1 | Installation instructions 2 | ========================= 3 | 4 | Parsifal currently depends on the following OCaml libraries: 5 | 6 | * Lwt 7 | * Calendar 8 | * Cryptokit 9 | * OUnit (for some tests) 10 | 11 | To compile Parsifal, you also need the following tools: 12 | 13 | * Make 14 | * OCaml 15 | * OCaml-findlib 16 | * OCaml IDL 17 | * krb5 18 | * xz-utils 19 | 20 | 21 | Compilation environment for Debian Buster 22 | ----------------------------------------- 23 | 24 | To compile Parsifal, you need to ensure you have the following Debian 25 | packages installed: 26 | 27 | * git 28 | * make 29 | * ocaml 30 | * ocaml-findlib 31 | * camlidl 32 | * camlp4 33 | * liblwt-ocaml-dev 34 | * libcalendar-ocaml-dev 35 | * libcryptokit-ocaml-dev 36 | * libounit-ocaml-dev 37 | * libkrb5-dev 38 | 39 | This can be achieved using the following command line, as root: 40 | 41 | # apt-get install git make ocaml ocaml-findlib camlidl camlp4 liblwt-ocaml-dev libcalendar-ocaml-dev libcryptokit-ocaml-dev libounit-ocaml-dev libkrb5-dev 42 | 43 | Parsifal v0.3 is compatible with Debian Stretch, but the current 44 | version does not compile on Stretch or earlier versions of Debian. If 45 | you encounter such problems, you might need to rely on opam. 46 | 47 | 48 | Compilation environment using OPAM 49 | ---------------------------------- 50 | 51 | You must first install some required dependencies: 52 | 53 | # apt-get install git m4 libkrb5-dev pkg-config zlib1g-dev libgmp-dev 54 | 55 | The rest of the procedure can be done as an unprivileged user: 56 | 57 | % opam install ocamlfind camlp4 lwt calendar cryptokit ounit camlidl 58 | 59 | 60 | 61 | Actual compilation instructions 62 | ------------------------------- 63 | 64 | Assuming you want to compile parsifal in the ~/parsifal directory, you 65 | can then type in the following commands: 66 | 67 | % cd 68 | % git clone https://github.com/picty/parsifal 69 | % cd parsifal 70 | % make 71 | 72 | To install the libraries and the binaries in standard directories, you 73 | must execute the following command as root: 74 | 75 | # make install 76 | 77 | Alternatively, to install the libraries and the binaries in a custom 78 | location, for example in subdirectories of your home directory: 79 | 80 | % LIBDIR=$HOME/.ocamlpath BINDIR=$HOME/bin make install 81 | 82 | 83 | Notes 84 | ----- 85 | 86 | These instructions have been tested with Debian Buster, and with opam 87 | 1.2 (and OCaml 4.05.0 and 4.06.0). 88 | 89 | It could also work with other versions of opam and of the compiler. 90 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/LICENSE.txt -------------------------------------------------------------------------------- /Licence_CeCILL_V2-fr.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/Licence_CeCILL_V2-fr.txt -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | LIBDIRS=syntax core lwt crypto net ssl formats kerby openpgp 2 | DIRS=ssl-tools pci tools 3 | CHECK_DIRS=syntax/unit core/test core/unit crypto/test net/test ssl/test ssl/unit formats/test 4 | 5 | all: libs 6 | for i in $(DIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i all || exit 1; done 7 | 8 | libs: 9 | for i in $(LIBDIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i all byte || exit 1; done 10 | 11 | byte: libs-byte 12 | for i in $(DIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i byte || exit 1; done 13 | 14 | libs-byte: 15 | for i in $(LIBDIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i byte || exit 1; done 16 | 17 | 18 | install: all 19 | for i in $(LIBDIRS) $(DIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i install || exit 1; done 20 | 21 | check: all 22 | for i in $(CHECK_DIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i check || exit 1; done 23 | 24 | clean: 25 | for i in $(DIRS) $(LIBDIRS) $(CHECK_DIRS); do OCAMLPATH="$(PWD)/usrlibocaml" $(MAKE) -C $$i clean || exit 1; done 26 | -------------------------------------------------------------------------------- /Makefile.template: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = project 3 | 4 | project_SRCS := project.ml 5 | 6 | # comment this line if not using camlp4 7 | USE_CAMLP4 = yes 8 | 9 | CC = gcc 10 | 11 | # use the following lines to guess .cmxa files from libs names. 12 | # remember, libs are always lowercase 13 | OCAML_LIBS = unix lwt lwt.unix str cryptokit parsifal_syntax parsifal_core parsifal_net parsifal_ssl 14 | 15 | # use the following variables to add extra flags (not guessed by ocamlfind) 16 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 17 | EXTRA_OCAMLOPT_LD_FLAGS = 18 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLC_LD_FLAGS = 20 | 21 | BUILD_DIR = build 22 | 23 | 24 | include Makefile.ocaml 25 | 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | README 2 | ====== 3 | 4 | Parsifal is an OCaml-based parsing engine. 5 | 6 | Parsifal is a collection of binary parsers and tools. The development 7 | is at an early stage (which explains the 0.1 version). 8 | 9 | There are several file formats or network protocols currently (at 10 | least partially) described: 11 | 12 | * X.509 certificates 13 | * SSL/TLS messages 14 | * DNS messages 15 | * MRT/BGP messages 16 | * Portable Executables 17 | * UEFI Firmwares 18 | * PKCS#1 keys and containers 19 | * PKCS#7 containers 20 | * Kerberos messages 21 | * OpenPGP messages 22 | * DVI documents 23 | * PNG images 24 | * PCAP/IP/TCP/UDP rudimentary support 25 | * NTP messages 26 | 27 | 28 | Here is the content of the various directories of parsifal repository: 29 | 30 | * syntax/ contains the preprocessor used to generate automatically 31 | types and functions 32 | * core/ is the standard parsifal library (common PTypes, input 33 | structures, useful functions to print values) 34 | * crypto/ contains the cryptographic functions and object 35 | descriptions: 36 | * hash function (MD5, SHA1 and SHA256) 37 | * Diffie-Hellman keys 38 | * DSA keys 39 | * RSA keys and implementation (PKCS#1) 40 | * PRNG 41 | * X.509 certificates 42 | * PKCS#7 containers 43 | * net/ describes some formats/protcols related to networking 44 | * PCAP/IP/TCP/UDP trivial support 45 | * BGP/MRT messages 46 | * DNS messages 47 | * NTP messages 48 | * ssl/ is a first step towards a functionnal TLS stack. For the 49 | moment, it contains the description of handshake messages and some 50 | useful functions to produce and read TLS records. 51 | * formats/ describes some file formats 52 | * DVI (DeVice Independant files) 53 | * Portable Executable 54 | * UEFI Firmware Volumes 55 | * TAR archives 56 | * PNG images 57 | * kerby/ is a collection of files to parse Kerberos messages 58 | * pci/ is about PCI Expansion ROMs 59 | 60 | * ssl-tools/ contains SSL/TLS useful programs 61 | * openpgp-tools/ contains a program to parse PGP containers 62 | * tools/ contains several tools like asn1parse or parsifal, which 63 | allows to parse and explore described PTypes 64 | 65 | Moreover, several test/ and unit/ exist, that contain unfinished 66 | programs and unit tests. usrlibocaml/ is only there to ease the 67 | compilation process. 68 | 69 | Finally, tutorial/ and papers/ contain the documentation and submitted 70 | papers describing parsifal, whereas docs contains RFCs and official 71 | specs. 72 | 73 | 74 | A Docker image is available in the pictyeye/parsifal repository on Docker 75 | Hub. It allows to use parsifal tools, such as probe_server: 76 | 77 | % docker run -ti --rm pictyeye/parsifal 78 | root@2cdbe79c9809:/# probe_server -H www.perdu.com extract-certs 79 | Saved 2 certificates 80 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/TODO -------------------------------------------------------------------------------- /core/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /core/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal core library" 3 | requires = "camlp4 parsifal_syntax str" 4 | archive(byte) = "parsifal_core.cma" 5 | archive(native) = "parsifal_core.cmxa" 6 | exists_if = "parsifal_core.cma" 7 | -------------------------------------------------------------------------------- /core/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = 3 | MLLIBS = parsifal_core 4 | LIBNAME = parsifal_core 5 | 6 | parsifal_core_SRCS := pOutput.ml parsifal.ml basePTypes.ml pTypes.ml asn1Engine.ml asn1PTypes.ml base64.ml \ 7 | getopt.ml protobuf.ml json.ml crc.ml zLib.ml 8 | 9 | # comment this line if not using camlp4 10 | USE_CAMLP4 = yes 11 | 12 | CC = gcc 13 | 14 | # use the following lines to guess .cmxa files from libs names. 15 | # remember, libs are always lowercase 16 | OCAML_LIBS = unix str calendar parsifal_syntax 17 | 18 | # use the following variables to add extra flags (not guessed by ocamlfind) 19 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 20 | EXTRA_OCAMLOPT_LD_FLAGS = 21 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 22 | EXTRA_OCAMLC_LD_FLAGS = 23 | 24 | BUILD_DIR = build 25 | 26 | 27 | include ../Makefile.ocaml 28 | -------------------------------------------------------------------------------- /core/crc.ml: -------------------------------------------------------------------------------- 1 | let polynom = 0xedb88320l 2 | 3 | let crc_table = Array.init 256 (fun n -> 4 | let crc = ref (Int32.of_int n) in 5 | for _j = 0 to 7 do 6 | crc := if Int32.to_int (Int32.logand (!crc) 1l) <> 0 then 7 | Int32.logxor (Int32.shift_right_logical (!crc) 1) polynom 8 | else 9 | Int32.shift_right_logical (!crc) 1; 10 | done; 11 | !crc) 12 | 13 | let update_crc crc buf pos len = 14 | let c = ref (Int32.lognot crc) in 15 | for i = pos to (len + pos - 1) do 16 | let b = Int32.of_int (int_of_char (String.get buf i)) in 17 | c := Int32.logxor (Array.get crc_table (Int32.to_int (Int32.logand (Int32.logxor !c b) 0xFFl))) (Int32.shift_right_logical !c 8); 18 | done; 19 | let ret = Int32.lognot !c in 20 | ret 21 | 22 | let crc32 s = 23 | let int32res = update_crc 0l s 0 (String.length s) in 24 | let res = Bytes.make 4 '\x00' in 25 | Bytes.set res 0 (char_of_int (Int32.to_int (Int32.logand (Int32.shift_right_logical int32res 24) 0xFFl))); 26 | Bytes.set res 1 (char_of_int (Int32.to_int (Int32.logand (Int32.shift_right_logical int32res 16) 0xFFl))); 27 | Bytes.set res 2 (char_of_int (Int32.to_int (Int32.logand (Int32.shift_right_logical int32res 8) 0xFFl))); 28 | Bytes.set res 3 (char_of_int (Int32.to_int (Int32.logand int32res 0xFFl))); 29 | Bytes.to_string res (* TODO: Should be an unsafe_to_string? *) 30 | 31 | let crc32le s = 32 | let int32res = update_crc 0l s 0 (String.length s) in 33 | let res = Bytes.make 4 '\x00' in 34 | Bytes.set res 3 (char_of_int (Int32.to_int (Int32.logand (Int32.shift_right_logical int32res 24) 0xFFl))); 35 | Bytes.set res 2 (char_of_int (Int32.to_int (Int32.logand (Int32.shift_right_logical int32res 16) 0xFFl))); 36 | Bytes.set res 1 (char_of_int (Int32.to_int (Int32.logand (Int32.shift_right_logical int32res 8) 0xFFl))); 37 | Bytes.set res 0 (char_of_int (Int32.to_int (Int32.logand int32res 0xFFl))); 38 | Bytes.to_string res (* TODO: Should be an unsafe_to_string? *) 39 | -------------------------------------------------------------------------------- /core/json.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | 3 | let rec json_of_value ?options:(options=default_output_options) = function 4 | | VUnit -> "null" 5 | | VBool b -> string_of_bool b 6 | | VInt i -> string_of_int i 7 | | VBigInt s | VString (s, true) -> "\"" ^ (hexdump s) ^ "\"" 8 | | VString (s, false) -> 9 | (* TODO: Sordid hack to produce valid JSON structures 10 | To clean that up, some work is needed on VString constructor 11 | to keep trace of the source encoding. *) 12 | Str.global_replace (Str.regexp "\\\\x") "\\u00" (quote_string s) 13 | | VEnum (s, _) -> quote_string s 14 | 15 | | VList l -> 16 | let new_options = incr_indent options in 17 | let indent = options.indent 18 | and new_indent = new_options.indent in 19 | let handle_elt v = json_of_value ~options:new_options v in 20 | Printf.sprintf "[%s%s%s%s%s]" options.eol new_indent 21 | (String.concat ("," ^ options.eol ^ new_indent) (List.map handle_elt l)) 22 | options.eol indent 23 | 24 | | VRecord l -> begin 25 | try 26 | if options.oo_verbose 27 | then raise Not_found 28 | else string_of_value (List.assoc "@string_of" l) 29 | with Not_found -> begin 30 | let new_options = incr_indent options in 31 | let indent = options.indent 32 | and new_indent = new_options.indent in 33 | let handle_field accu = function 34 | | _, VUnit -> accu 35 | | name, v -> 36 | if options.oo_verbose || (String.length name >= 1 && name.[0] <> '@') 37 | then 38 | (Printf.sprintf "%s: %s" (quote_string name) 39 | (json_of_value ~options:new_options v))::accu 40 | else accu 41 | in 42 | Printf.sprintf "{%s%s%s%s%s}" options.eol new_indent 43 | (String.concat ("," ^ options.eol ^ new_indent) (List.rev (List.fold_left handle_field [] l))) 44 | options.eol indent 45 | end 46 | end 47 | 48 | | VError _ -> failwith "json_of_value encountered an error in the value" 49 | | VAlias (n, v) -> 50 | if options.unfold_aliases 51 | then json_of_value ~options:options (VRecord [n, v]) 52 | else json_of_value ~options:options v 53 | | VUnparsed v -> json_of_value ~options:options v 54 | -------------------------------------------------------------------------------- /core/pOutput.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | buffer : Buffer.t; 3 | mutable cur_byte : int; 4 | mutable cur_freebits : int; 5 | } 6 | 7 | 8 | let default_buffer_size = ref 1024 9 | 10 | let create () = { 11 | buffer = Buffer.create !default_buffer_size; 12 | cur_byte = 0; 13 | cur_freebits = 8; 14 | } 15 | 16 | 17 | let clean_slate buf = 18 | if buf.cur_freebits <> 8 then begin 19 | let new_byte = buf.cur_byte lsl buf.cur_freebits in 20 | Buffer.add_char buf.buffer (char_of_int new_byte); 21 | buf.cur_byte <- 0; 22 | buf.cur_freebits <- 8 23 | end 24 | 25 | 26 | let contents buf = 27 | clean_slate buf; 28 | Buffer.contents buf.buffer 29 | 30 | let length buf = 31 | clean_slate buf; 32 | Buffer.length buf.buffer 33 | 34 | let byte_at buf n = int_of_char (Buffer.nth buf.buffer n) 35 | 36 | 37 | let bits_masks = [|0; 1; 3; 7; 15; 31; 63; 127; 255|] 38 | 39 | let add_bits buf nbits value = 40 | let rec add_bits_aux buf nbits cur_byte cur_freebits value = 41 | match nbits, cur_freebits with 42 | | _, 0 -> 43 | Buffer.add_char buf.buffer (char_of_int cur_byte); 44 | add_bits_aux buf nbits 0 8 value 45 | | 0, _ -> 46 | buf.cur_byte <- cur_byte; 47 | buf.cur_freebits <- cur_freebits 48 | | _, _ -> 49 | if nbits < cur_freebits 50 | then begin 51 | buf.cur_byte <- (cur_byte lsl nbits) lor (value land bits_masks.(nbits)); 52 | buf.cur_freebits <- cur_freebits - nbits 53 | end else begin 54 | let shift = nbits - cur_freebits in 55 | let new_byte = (cur_byte lsl cur_freebits) lor ((value lsr shift) land bits_masks.(cur_freebits)) in 56 | Buffer.add_char buf.buffer (char_of_int new_byte); 57 | add_bits_aux buf shift 0 8 value 58 | end 59 | in 60 | add_bits_aux buf nbits buf.cur_byte buf.cur_freebits value 61 | 62 | let add_byte buf b = 63 | clean_slate buf; 64 | Buffer.add_char buf.buffer (char_of_int b) 65 | 66 | let add_char buf c = 67 | clean_slate buf; 68 | Buffer.add_char buf.buffer c 69 | 70 | let add_string buf s = 71 | clean_slate buf; 72 | Buffer.add_string buf.buffer s 73 | 74 | let add_bytes buf s = 75 | clean_slate buf; 76 | Buffer.add_bytes buf.buffer s 77 | 78 | let add_substring buf s index len = 79 | clean_slate buf; 80 | Buffer.add_substring buf.buffer s index len 81 | 82 | let bprintf buf format = 83 | Printf.bprintf buf.buffer format 84 | 85 | let add_output buf sub_buf = 86 | clean_slate buf; 87 | clean_slate sub_buf; 88 | Buffer.add_buffer buf.buffer sub_buf.buffer 89 | 90 | 91 | let output_buffer ch buf = Buffer.output_buffer ch buf.buffer 92 | -------------------------------------------------------------------------------- /core/pOutput.mli.TODO: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val default_buffer_size : int ref 4 | val create : unit -> t 5 | 6 | val contents : t -> string 7 | val length : t -> int 8 | val byte_at : t -> int -> int 9 | 10 | val add_bits : t -> int -> int -> unit 11 | val add_byte : t -> int -> unit 12 | val add_char : t -> char -> unit 13 | val add_string : t -> string -> unit 14 | val add_substring : t -> string -> int -> int -> unit 15 | val bprintf : t -> ('a, Buffer.t, unit) format -> 'a 16 | val add_output : t -> t -> unit 17 | 18 | val output_buffer : out_channel -> t -> unit 19 | -------------------------------------------------------------------------------- /core/test/.gitignore: -------------------------------------------------------------------------------- 1 | test_parsifal 2 | test_parsifal.byte 3 | test_getopt 4 | test_getopt.byte 5 | test_protobuf 6 | test_protobuf.byte 7 | -------------------------------------------------------------------------------- /core/test/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_parsifal test_getopt test_protobuf 3 | 4 | test_parsifal_SRCS := test_parsifal.ml 5 | test_getopt_SRCS := test_getopt.ml 6 | test_protobuf_SRCS := test_protobuf.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix str calendar parsifal_syntax parsifal_core 16 | 17 | # use the following variables to add extra flags (not guessed by ocamlfind) 18 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLOPT_LD_FLAGS = 20 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLC_LD_FLAGS = 22 | 23 | BUILD_DIR = build 24 | 25 | 26 | 27 | include ../../Makefile.ocaml 28 | 29 | 30 | check: all 31 | ./test_parsifal 32 | -------------------------------------------------------------------------------- /core/test/test_getopt.ml: -------------------------------------------------------------------------------- 1 | open Getopt 2 | 3 | let verbose = ref false 4 | let level = ref 0 5 | 6 | let options = [ 7 | mkopt (Some 'h') "help" Usage "show this help"; 8 | mkopt (Some 'v') "verbose" (Set verbose) "activate the verbose mode"; 9 | mkopt (Some 'l') "level" (IntVal level) "set the level"; 10 | ] 11 | 12 | let _ = 13 | let args = parse_args ~progname:"test_getopt" options Sys.argv in 14 | Printf.printf "Verbose = %s\n" (string_of_bool !verbose); 15 | Printf.printf "Level = %d\n" !level; 16 | Printf.printf "Arguments =\n %s\n" (String.concat "\n " args) 17 | -------------------------------------------------------------------------------- /core/test/test_parsifal.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open Asn1PTypes 4 | 5 | enum tls_version (16, UnknownVal V_Unknown) = 6 | | 0x0002 -> V_SSLv2, "SSLv2" 7 | | 0x0300 -> V_SSLv3, "SSLv3" 8 | | 0x0301 -> V_TLSv1, "TLSv1.0" 9 | | 0x0302 -> V_TLSv1_1, "TLSv1.1" 10 | | 0x0303 -> V_TLSv1_2, "TLSv1.2" 11 | 12 | enum tls_version_bis (16, Exception) = 13 | | 0x0002 -> V_SSLv2, "SSLv2" 14 | | 0x0300 -> V_SSLv3, "SSLv3" 15 | | 0x0301 -> V_TLSv1, "TLSv1.0" 16 | | 0x0302 -> V_TLSv1_1, "TLSv1.1" 17 | | 0x0303 -> V_TLSv1_2, "TLSv1.2" 18 | 19 | struct st [top] = { 20 | x : uint8; 21 | y : string(x); 22 | len : uint8; 23 | l : list(len) of uint16; 24 | } 25 | 26 | struct st2 [top] = { 27 | l : uint8; 28 | a : array(l) of uint16 29 | } 30 | 31 | alias l1 [top] = list of st 32 | 33 | struct rsa_public_key_content = { 34 | p_modulus : Asn1PTypes.der_integer; 35 | p_publicExponent : Asn1PTypes.der_integer 36 | } 37 | 38 | asn1_alias rsa_public_key [top] 39 | 40 | asn1_union der_time [top; enrich; exhaustive] (UnparsedTime) = 41 | | (Asn1Engine.C_Universal, false, Asn1Engine.T_UTCTime) -> UTCTime of Asn1PTypes.der_utc_time_content 42 | | (Asn1Engine.C_Universal, false, Asn1Engine.T_GeneralizedTime) -> GeneralizedTime of Asn1PTypes.der_generalized_time_content 43 | 44 | 45 | let test (parse : string_input -> 'a) 46 | (raw_dump : POutput.t -> 'a -> unit) 47 | (value_of : 'a -> value) 48 | (name : string) (s : string) = 49 | try 50 | let dump = exact_dump raw_dump in 51 | let x = parse (input_of_string "" s) in 52 | print_endline (print_value ~name:name (value_of x)); 53 | if (dump x = s) 54 | then Printf.printf "Parse/Dump is idempotent for %s\n" name 55 | else Printf.printf "Parse/Dump is NOT idempotent for %s\n" name 56 | with ParsingException (e, h) -> 57 | Printf.printf "test failed for %s: %s\n" name (string_of_exception e h) 58 | 59 | 60 | let test_st = test exact_parse_st dump_st value_of_st "st" 61 | let test_st2 = test exact_parse_st2 dump_st2 value_of_st2 "st2" 62 | let test_l1 = test exact_parse_l1 dump_l1 value_of_l1 "l1" 63 | let test_rsa = test exact_parse_rsa_public_key dump_rsa_public_key value_of_rsa_public_key "rsa_public_key" 64 | let test_der_object = test parse_der_object dump_der_object value_of_der_object "der_object" 65 | 66 | let _ = 67 | print_endline (string_of_tls_version (tls_version_of_int 768)); 68 | print_endline (string_of_tls_version_bis (tls_version_bis_of_int 768)); 69 | test_st "\x04toto\x02AA"; 70 | test_st "\x04toto\x02AABB"; 71 | test_st "\x04toto\x02AABBCC"; 72 | test_st2 "\x02AABB"; 73 | test_st2 "\x03AABBCC"; 74 | test_st2 "\x02"; 75 | test_l1 "\x04toto\x02AABB\x02yo\x00"; 76 | test_rsa "\x30\x0d\x02\x08AABBCCDD\x02\x01\x03"; 77 | test_der_object "\x30\x0d\x02\x08AABBCCDD\x02\x01\x03"; 78 | for i = 1 to (Array.length Sys.argv) - 1 do 79 | match get (value_of_st (parse_st (input_of_string "" "\x04toto\x02AABB"))) Sys.argv.(i) with 80 | | Left e -> Printf.printf "Left \"%s\"\n" e 81 | | Right s -> Printf.printf "Right %s\n" s 82 | done; 83 | () 84 | -------------------------------------------------------------------------------- /core/test/test_protobuf.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Protobuf 3 | open Getopt 4 | 5 | 6 | type action = Examples | Print 7 | let action = ref Print 8 | let set_action value = TrivialFun (fun () -> action := value) 9 | 10 | let verbose = ref false 11 | 12 | let enrich_style = ref DefaultEnrich 13 | let set_enrich_level l = 14 | if l > 0 then begin 15 | enrich_style := EnrichLevel l; 16 | ActionDone 17 | end else ShowUsage (Some "enrich level should be a positive number.") 18 | let update_enrich_level l = 19 | let new_style = match !enrich_style with 20 | | DefaultEnrich | NeverEnrich -> EnrichLevel l 21 | | EnrichLevel x -> EnrichLevel (max x l) 22 | | AlwaysEnrich -> AlwaysEnrich 23 | in enrich_style := new_style 24 | 25 | let options = [ 26 | mkopt (Some 'h') "help" Usage "show this help"; 27 | mkopt (Some 'v') "verbose" (Set verbose) "print more info to stderr"; 28 | mkopt (Some 'e') "examples" (set_action Examples) "show examples"; 29 | 30 | mkopt None "always-enrich" (TrivialFun (fun () -> enrich_style := AlwaysEnrich)) "always enrich the structure parsed"; 31 | mkopt None "never-enrich" (TrivialFun (fun () -> enrich_style := NeverEnrich)) "never enrich the structure parsed"; 32 | mkopt None "enrich-level" (IntFun set_enrich_level) "enrich the structure parsed up to a certain level"; 33 | ] 34 | 35 | 36 | 37 | let examples = [ 38 | "\x08\x96\x01"; 39 | "\x12\x07\x74\x65\x73\x74\x69\x6e\x67"; 40 | "\x1a\x03\x08\x96\x01"; 41 | ] 42 | 43 | let test_one_buf b = 44 | print_endline (print_rec_protobuf (parse_rec_protobuf (input_of_string "Buf" b))) 45 | 46 | 47 | let handle_one_file input = 48 | let protobuf = parse_rec_protobuf input in 49 | print_endline (print_rec_protobuf protobuf) 50 | 51 | let _ = 52 | try 53 | let args = parse_args ~progname:"test_protobuf" options Sys.argv in 54 | match !action, args with 55 | | Examples, _ -> List.iter test_one_buf examples 56 | | Print, [] -> 57 | let i = string_input_of_stdin ~enrich:(!enrich_style) ~verbose:(!verbose) () in 58 | handle_one_file i 59 | | Print, l -> 60 | let aux fn = 61 | let i = string_input_of_filename ~enrich:(!enrich_style) ~verbose:(!verbose) fn in 62 | handle_one_file i 63 | in 64 | List.iter aux l 65 | with 66 | | End_of_file -> () 67 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h) 68 | | e -> prerr_endline (Printexc.to_string e) 69 | -------------------------------------------------------------------------------- /core/unit/.gitignore: -------------------------------------------------------------------------------- 1 | oUnit-anon.cache 2 | test_basePTypes 3 | test_basePTypes.byte 4 | test_base64 5 | test_base64.byte 6 | -------------------------------------------------------------------------------- /core/unit/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_basePTypes test_base64 3 | 4 | test_basePTypes_SRCS := test_basePTypes.ml 5 | test_base64_SRCS := test_base64.ml 6 | 7 | # comment this line if not using camlp4 8 | USE_CAMLP4 = yes 9 | 10 | CC = gcc 11 | 12 | # use the following lines to guess .cmxa files from libs names. 13 | # remember, libs are always lowercase 14 | OCAML_LIBS = unix str parsifal_syntax parsifal_core oUnit 15 | 16 | # use the following variables to add extra flags (not guessed by ocamlfind) 17 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 18 | EXTRA_OCAMLOPT_LD_FLAGS = 19 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 20 | EXTRA_OCAMLC_LD_FLAGS = 21 | 22 | BUILD_DIR = build 23 | 24 | 25 | 26 | include ../../Makefile.ocaml 27 | 28 | 29 | check: test_basePTypes test_base64 30 | ./test_basePTypes 31 | ./test_base64 32 | -------------------------------------------------------------------------------- /core/unit/test_base64.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | open Parsifal 4 | open BasePTypes 5 | open Base64 6 | 7 | 8 | (* Generic functions *) 9 | (* TODO: Move those funs elsewhere *) 10 | 11 | let random_string len () = 12 | let res = Bytes.make len '\x00' in 13 | for i = 0 to (len - 1) do 14 | Bytes.set res i (char_of_int (Random.int 256)) 15 | done; 16 | Bytes.to_string res (* TODO: Use unsafe_to_string *) 17 | 18 | let ntimes n f () = for _i = 1 to n do f (); done 19 | 20 | 21 | let str_wrap parse_fun s = exact_parse parse_fun (input_of_string "" s) 22 | 23 | 24 | 25 | (* Idempotence and string input tests *) 26 | (* TODO: Move those funs elsewhere *) 27 | 28 | let test_idem_pod parse dump rnd_fun () = 29 | let v1 = rnd_fun () in 30 | let v2 = parse (exact_dump dump v1) in 31 | assert_equal v1 v2 32 | 33 | 34 | (* TODO: Add tests on invalid headers, and tests on invalid base64 chars *) 35 | 36 | 37 | let n = ref 10 38 | 39 | let mk_one_b64_test header_type len = 40 | let prefix, dump_hdr = match header_type with 41 | | AnyHeader -> "test_anyheader", HeaderInList ["ANYHEADER"] 42 | | HeaderInList [_] -> "test_header", header_type 43 | | HeaderInList _ | NoHeader -> "test_noheader", header_type 44 | in 45 | let rnd_str = random_string len in 46 | let parse = parse_base64_container header_type "base64_container" parse_rem_string 47 | and dump = dump_base64_container dump_hdr dump_string in 48 | [(prefix ^ "_idem_pod_" ^ (string_of_int len)) >:: ntimes !n (test_idem_pod (str_wrap parse) dump rnd_str)] 49 | 50 | 51 | let base64_tests = 52 | let headers = [AnyHeader; HeaderInList ["SOMETHING"]; NoHeader] 53 | and lens = [0; 1; 2; 3; 4; 5; 6; 7; 14; 15; 16; 17; 47; 48; 49; 1024; 1025; 1026] in 54 | List.flatten (List.flatten (List.map (fun h -> List.map (fun l -> mk_one_b64_test h l) lens) headers)) 55 | 56 | 57 | let tests = List.flatten [ 58 | base64_tests 59 | ] 60 | 61 | let suite = "Base64 Unit Tests" >::: tests 62 | 63 | let aggregate exit_code = function 64 | | RSuccess _ -> exit_code 65 | | _ -> 1 66 | 67 | let _ = 68 | Random.self_init (); 69 | let results = run_test_tt_main suite in 70 | exit (List.fold_left aggregate 0 results) 71 | -------------------------------------------------------------------------------- /core/unit/test_string_inputs.ml.TODO: -------------------------------------------------------------------------------- 1 | (* TODO: add tests about get_in / get_out / exception throwing / etc *) 2 | -------------------------------------------------------------------------------- /crypto/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /crypto/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal crypto library" 3 | requires = "unix str cryptokit camlp4 parsifal_syntax parsifal_core" 4 | archive(byte) = "parsifal_crypto.cma" 5 | archive(native) = "parsifal_crypto.cmxa" 6 | exists_if = "parsifal_crypto.cma" 7 | -------------------------------------------------------------------------------- /crypto/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = 3 | MLLIBS = parsifal_crypto 4 | LIBNAME = parsifal_crypto 5 | 6 | parsifal_crypto_SRCS := dHKey.ml dSAKey.ml eCKey.ml x509Basics.ml x509Extensions.ml cryptoUtil.ml \ 7 | randomEngine.ml pkcs1.ml x509.ml pkcs7.ml x509Util.ml crl.ml 8 | 9 | # comment this line if not using camlp4 10 | USE_CAMLP4 = yes 11 | 12 | CC = gcc 13 | 14 | # use the following lines to guess .cmxa files from libs names. 15 | # remember, libs are always lowercase 16 | OCAML_LIBS = unix str calendar zarith cryptokit parsifal_syntax parsifal_core 17 | 18 | # use the following variables to add extra flags (not guessed by ocamlfind) 19 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 20 | EXTRA_OCAMLOPT_LD_FLAGS = 21 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 22 | EXTRA_OCAMLC_LD_FLAGS = 23 | 24 | BUILD_DIR = build 25 | 26 | 27 | include ../Makefile.ocaml 28 | -------------------------------------------------------------------------------- /crypto/crl.ml: -------------------------------------------------------------------------------- 1 | open Asn1Engine 2 | open Asn1PTypes 3 | open X509 4 | open X509Basics 5 | open X509Extensions 6 | 7 | asn1_struct revokedCertificate = { 8 | userCertificate : der_integer; 9 | revocationDate : der_time; 10 | optional crlEntryExtensions : extension_list 11 | } 12 | 13 | asn1_alias revokedCertificates = seq_of revokedCertificate (* min = 1 *) 14 | 15 | asn1_struct tbsCertList = { 16 | optional version : der_smallint; 17 | signature : algorithmIdentifier; 18 | issuer : distinguishedName; 19 | thisUpdate : der_time; 20 | optional nextUpdate : der_time; 21 | optional revokedCertificates : revokedCertificates; 22 | optional crlExtensionscrlExtensions : asn1 [(C_ContextSpecific, true, T_Unknown 0)] of extension_list; 23 | } 24 | 25 | asn1_struct certificateList = { 26 | tbsCertList : tbsCertList; 27 | signatureAlgorithm : algorithmIdentifier; 28 | signatureValue : bitstring_container of signature(signatureType_of_algo signatureAlgorithm) 29 | } 30 | -------------------------------------------------------------------------------- /crypto/cryptoUtil.ml: -------------------------------------------------------------------------------- 1 | type signature_result = 2 | | SignatureOK 3 | | UnknownSignatureAlgorithm of string 4 | | UnknownHashAlgorithm of string 5 | | InvalidSignature 6 | 7 | let string_of_signature_result = function 8 | | SignatureOK -> "Signature OK" 9 | | UnknownSignatureAlgorithm s -> "Unknown Signature Algorithm: " ^ s 10 | | UnknownHashAlgorithm s -> "Unknown Hash Algorithm: " ^ s 11 | | InvalidSignature -> "Invalid Signature" 12 | 13 | let md5sum s = Cryptokit.hash_string (Cryptokit.Hash.md5 ()) s;; 14 | let sha1sum s = Cryptokit.hash_string (Cryptokit.Hash.sha1 ()) s;; 15 | let sha256sum s = Cryptokit.hash_string (Cryptokit.Hash.sha256 ()) s;; 16 | let sha384sum s = Cryptokit.hash_string (Cryptokit.Hash.sha384 ()) s;; 17 | let sha512sum s = Cryptokit.hash_string (Cryptokit.Hash.sha512 ()) s;; 18 | let sha224sum s = Cryptokit.hash_string (Cryptokit.Hash.sha224 ()) s;; 19 | 20 | let exp_mod m exp n = 21 | let key = { 22 | Cryptokit.RSA.size = (String.length n) * 8; 23 | Cryptokit.RSA.n = n; 24 | Cryptokit.RSA.e = exp; 25 | Cryptokit.RSA.d = ""; 26 | Cryptokit.RSA.p = ""; 27 | Cryptokit.RSA.q = ""; 28 | Cryptokit.RSA.dp = ""; 29 | Cryptokit.RSA.dq = ""; 30 | Cryptokit.RSA.qinv = ""; 31 | } in 32 | Cryptokit.RSA.encrypt key m 33 | -------------------------------------------------------------------------------- /crypto/dHKey.ml: -------------------------------------------------------------------------------- 1 | open Asn1PTypes 2 | 3 | asn1_struct dh_params = { 4 | dh_p : der_integer; 5 | dh_g : der_integer; 6 | dh_order : der_integer 7 | } 8 | 9 | alias dh_public_key = der_integer 10 | -------------------------------------------------------------------------------- /crypto/dSAKey.ml: -------------------------------------------------------------------------------- 1 | open Asn1PTypes 2 | 3 | asn1_struct dsa_params = { 4 | dsa_p : der_integer; 5 | dsa_q : der_integer; 6 | dsa_g : der_integer 7 | } 8 | 9 | 10 | (* TODO: Add checks? *) 11 | alias dsa_public_key = der_integer 12 | 13 | 14 | asn1_struct dsa_signature = { 15 | dsa_r : der_integer; 16 | dsa_s : der_integer 17 | } 18 | 19 | -------------------------------------------------------------------------------- /crypto/eCKey.ml: -------------------------------------------------------------------------------- 1 | open Asn1PTypes 2 | 3 | alias ec_params = der_object 4 | 5 | alias ec_public_key = binstring 6 | 7 | asn1_struct ecdsa_signature = { 8 | ecdsa_x : der_integer; 9 | ecdsa_y : der_integer 10 | } 11 | -------------------------------------------------------------------------------- /crypto/randomEngine.ml: -------------------------------------------------------------------------------- 1 | (* 2 | In the interactive mode, we can seed the random engine with 3 | random.seed (read_some (open ("/dev/urandom"), 64)) 4 | *) 5 | 6 | (* TODO: Work on exceptions *) 7 | exception InvalidRandomState 8 | 9 | let refresh_bh h s x = 10 | let n = String.length !s in 11 | let tmp = Bytes.of_string (h ("extract" ^ x)) in 12 | if n = Bytes.length tmp then begin 13 | Cryptokit.xor_string !s 0 tmp 0 n; 14 | s := h ("G_prime" ^ (Bytes.to_string tmp)) 15 | end else raise InvalidRandomState 16 | 17 | let next_bh h s () = 18 | let rnd_bytes = h ("G_first" ^ !s) in 19 | s := h ("G_secnd" ^ !s); 20 | rnd_bytes 21 | 22 | type state = { 23 | seed : string -> unit; 24 | refresh : string -> unit; 25 | next : unit -> string; 26 | } 27 | 28 | let make_bh_prng h seed = 29 | let state = ref (h seed) in 30 | { seed = (fun x -> state := (h x)); 31 | refresh = refresh_bh h state; 32 | next = next_bh h state } 33 | 34 | 35 | let random_char s = 36 | let tmp = s.next () in 37 | tmp.[0] 38 | 39 | let random_string s len = 40 | let rec aux accu remaining = 41 | let tmp = s.next () in 42 | if String.length tmp >= remaining 43 | then String.concat "" ((String.sub tmp 0 remaining)::accu) 44 | else aux (tmp::accu) (remaining - (String.length tmp)) 45 | in aux [] len 46 | 47 | let random_int s max = 48 | let rec n_bytes n = 49 | if n = 0 then 0 50 | else 1 + (n_bytes (n lsr 8)) 51 | in 52 | 53 | (* TODO: Exception? *) 54 | if max < 0 then raise (Failure "random_int expect a positive max"); 55 | let len = n_bytes (max - 1) in 56 | 57 | (* TODO: Add an optimisation here to mask some bits: it is possible 58 | to have only one execution of the loop *) 59 | 60 | let rec aux () = 61 | let tmp = ref 0 62 | and rnd = random_string s len in 63 | for i = 0 to (len - 1) do 64 | tmp := (!tmp lsl 8) lor (int_of_char rnd.[i]) 65 | done; 66 | if !tmp < max then !tmp else aux () 67 | in 68 | aux () 69 | 70 | 71 | 72 | let seeded_random_generator seed = 73 | make_bh_prng CryptoUtil.sha256sum seed 74 | 75 | let default_random_generator () = 76 | let f = open_in "/dev/urandom" in 77 | let seed = Bytes.create 32 in 78 | really_input f seed 0 32; 79 | close_in f; 80 | seeded_random_generator (Bytes.to_string seed) 81 | 82 | let dummy_random_generator () = { 83 | seed = (fun _ -> ()); 84 | refresh = (fun _ -> ()); 85 | next = (fun () -> String.make 32 '\x00'); 86 | } 87 | -------------------------------------------------------------------------------- /crypto/test/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | test_random 3 | test_random.byte 4 | -------------------------------------------------------------------------------- /crypto/test/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_random 3 | 4 | test_random_SRCS := test_random.ml 5 | 6 | # comment this line if not using camlp4 7 | USE_CAMLP4 = yes 8 | 9 | CC = gcc 10 | 11 | # use the following lines to guess .cmxa files from libs names. 12 | # remember, libs are always lowercase 13 | OCAML_LIBS = unix str zarith result cryptokit parsifal_syntax parsifal_core parsifal_crypto 14 | 15 | # use the following variables to add extra flags (not guessed by ocamlfind) 16 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 17 | EXTRA_OCAMLOPT_LD_FLAGS = 18 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLC_LD_FLAGS = 20 | 21 | BUILD_DIR = build 22 | 23 | 24 | 25 | include ../../Makefile.ocaml 26 | 27 | 28 | check: all 29 | ./test_random 30 | -------------------------------------------------------------------------------- /crypto/test/test_random.ml: -------------------------------------------------------------------------------- 1 | open RandomEngine 2 | open Getopt 3 | open CryptoUtil 4 | 5 | let state = make_bh_prng sha256sum "tititoto" 6 | 7 | let reseed_urandom () = 8 | let seed = Bytes.create 1024 in 9 | let f = open_in "/dev/urandom" in 10 | really_input f seed 0 1024; 11 | state.seed (Bytes.to_string seed) 12 | 13 | let reseed s = state.seed s; ActionDone 14 | let print_random_int n = print_endline (string_of_int (random_int state n)); ActionDone 15 | let print_random_string n = print_endline (Parsifal.hexdump (random_string state n)); ActionDone 16 | 17 | let options = [ 18 | mkopt (Some 'h') "help" Usage "show this help"; 19 | 20 | mkopt (Some 'u') "urandom" (TrivialFun reseed_urandom) "seed the generator with 1024 bytes from /dev/urandom"; 21 | mkopt (Some 's') "seed" (StringFun reseed) "seed the generator with s"; 22 | mkopt (Some 'I') "integer" (IntFun print_random_int) "print a random int between 0 and n"; 23 | mkopt (Some 'S') "string" (IntFun print_random_string) "print a random string of n characters"; 24 | ] 25 | 26 | 27 | let _ = 28 | ignore (parse_args ~progname:"test_random" options Sys.argv); 29 | -------------------------------------------------------------------------------- /crypto/x509CertificateStore.ml.TODO: -------------------------------------------------------------------------------- 1 | open X509 2 | 3 | type enriched_certificate = { 4 | cert_content : certificate; 5 | cert_decorators : (string, string) Hashtbl.t 6 | } 7 | 8 | type certificate_store = { 9 | cert_by_value : (certificate, enriched_certificate) Hashtbl.t; 10 | cert_by_subject : (string, enriched_certificate) Hashtbl.t; 11 | cert_by_issuer : (string, enriched_certificate) Hashtbl.t; 12 | } 13 | 14 | 15 | let new_store ?size:(size=100) () = { 16 | cert_by_value = Hashtbl.create size; 17 | cert_by_subject = Hashtbl.create size; 18 | cert_by_issuer = Hashtbl.create size; 19 | } 20 | 21 | 22 | let find_by_issuer store issuer = Hashtbl.find_all store.cert_by_issuer issuer 23 | let find_by_subject store issuer = Hashtbl.find_all store.cert_by_issuer issuer 24 | let is_present store cert = Hashtbl.mem store.cert_by_value cert 25 | 26 | 27 | let add_cert store cert = 28 | if not (is_present store cert) then begin 29 | let enriched_cert = { 30 | cert_content = cert; 31 | cert_decorators = Hashtbl.create 30; 32 | } in 33 | Hashtbl.replace store.cert_by_value cert enriched_cert; 34 | Hashtbl.add store.cert_by_subject cert.tbsCertificate.subject_raw enriched_cert; 35 | Hashtbl.add store.cert_by_issuer cert.tbsCertificate.issuer_raw enriched_cert 36 | end; 37 | enriched_cert 38 | 39 | 40 | let filter_out h cert k = 41 | let rec filter_out_aux () = 42 | try 43 | let c = Hashtbl.find h k in 44 | Hashtbl.remove h k; 45 | if c.cert_content <> cert then begin 46 | filter_out_aux (); 47 | Hashtbl.add h k c 48 | end 49 | with Not_found -> () 50 | in filter_out_aux () 51 | 52 | let remove_cert store cert = 53 | Hashtbl.remove store.cert_by_value cert; 54 | filter_out store.cert_by_issuer cert cert.tbsCertificate.issuer_raw; 55 | filter_out store.cert_by_subject cert cert.tbsCertificate.subject_raw 56 | -------------------------------------------------------------------------------- /docker/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | PROGDIR="$(dirname "$0")" 6 | cd $PROGDIR 7 | 8 | docker build -t parsifal-test:opam2-ocaml-4.06 --build-arg OCAML_VERSION=4.06 opam2 9 | docker build -t parsifal-test:opam2-ocaml-4.05 --build-arg OCAML_VERSION=4.05 opam2 10 | docker build -t parsifal-test:buster buster 11 | 12 | for i in opam2-ocaml-4.06 opam2-ocaml-4.05 buster; do 13 | docker tag parsifal-test:"$i" pictyeye/parsifal-test:"$i" 14 | done 15 | 16 | for i in opam2-ocaml-4.06 opam2-ocaml-4.05 buster; do 17 | docker push pictyeye/parsifal-test:"$i" 18 | done 19 | -------------------------------------------------------------------------------- /docker/buster/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM debian:buster 2 | 3 | RUN apt-get update 4 | RUN apt-get update && apt install --no-install-recommends -y git make 5 | RUN apt-get update && apt install --no-install-recommends -y ocaml ocaml-findlib camlidl camlp4 liblwt-ocaml-dev libcalendar-ocaml-dev libcryptokit-ocaml-dev libounit-ocaml-dev libkrb5-dev 6 | RUN apt-get update && apt install --no-install-recommends -y ca-certificates 7 | RUN apt clean 8 | -------------------------------------------------------------------------------- /docker/mk_release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | TAG="$1" 6 | [ -n "$TAG" ] || ( echo "$0 " >&2 ; exit 1 ) 7 | 8 | PROGDIR="$(dirname "$0")" 9 | cd $PROGDIR 10 | 11 | [ -n "$PUBLISH_RELEASE" ] && git tag "$TAG" 12 | 13 | cd .. 14 | git archive -o docker/release/parsifal.tar --format tar --prefix parsifal/ HEAD 15 | 16 | docker build -t parsifal:"$TAG" docker/release 17 | 18 | docker tag parsifal:"$TAG" pictyeye/parsifal:"$TAG" 19 | docker tag parsifal:"$TAG" pictyeye/parsifal:latest 20 | [ -n "$PUBLISH_RELEASE" ] && docker push pictyeye/parsifal:"$TAG" 21 | [ -n "$PUBLISH_RELEASE" ] && docker push pictyeye/parsifal:latest 22 | 23 | rm -f docker/release/parsifal.tar 24 | -------------------------------------------------------------------------------- /docker/opam2/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ocaml/opam2 2 | 3 | RUN sudo apt-get install -y git m4 libkrb5-dev pkg-config zlib1g-dev libgmp-dev 4 | 5 | ARG OCAML_VERSION=4.05 6 | RUN opam switch ${OCAML_VERSION} && eval $(opam env) && opam install ocamlfind camlp4 lwt calendar cryptokit ounit camlidl 7 | -------------------------------------------------------------------------------- /docker/release/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM pictyeye/parsifal-test:buster 2 | 3 | COPY parsifal.tar /tmp/parsifal.tar 4 | RUN cd /tmp/ && \ 5 | tar xf parsifal.tar && \ 6 | cd parsifal && \ 7 | make && \ 8 | LIBDIR=/usr/lib/ocaml make install && \ 9 | rm -rf /tmp/parsifal /tmp/parsifal.tar 10 | -------------------------------------------------------------------------------- /docs/bgp/index.txt: -------------------------------------------------------------------------------- 1 | - IANA TLS parameters 2 | * http://www.iana.org/assignments/bgp-parameters/bgp-parameters.xml 3 | - BGP RFCs 4 | * rfc4271, rfc6396, rfc4760 5 | - MRT data samples 6 | * http://data.ris.ripe.net/rrc00/ 7 | -------------------------------------------------------------------------------- /docs/dex/dex-format.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/dex/dex-format.html -------------------------------------------------------------------------------- /docs/dex/dex-format.url: -------------------------------------------------------------------------------- 1 | http://source.android.com/tech/dalvik/dex-format.html 2 | -------------------------------------------------------------------------------- /docs/dvi/tb06software.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/dvi/tb06software.pdf -------------------------------------------------------------------------------- /docs/jpg/DC-008-2010_E.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/jpg/DC-008-2010_E.pdf -------------------------------------------------------------------------------- /docs/jpg/JPEG.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/jpg/JPEG.pdf -------------------------------------------------------------------------------- /docs/jpg/Wallace.JPEG.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/jpg/Wallace.JPEG.pdf -------------------------------------------------------------------------------- /docs/jpg/itu-t81.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/jpg/itu-t81.pdf -------------------------------------------------------------------------------- /docs/jpg/jfif-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/jpg/jfif-1.pdf -------------------------------------------------------------------------------- /docs/jpg/jpg.txt: -------------------------------------------------------------------------------- 1 | = itu-t81.pdf = 2 | This is the first version of ITU jpeg. 3 | Appendix B describes the format structure. 4 | 5 | = jfif-1.pdf = 6 | The JFIF format allows for adding metadata (magic: APP0) 7 | 8 | = DC-008-2010_E.pdf = 9 | Chap.4 10 | EXIF format contains photo-oriented metadata (magic: APP1) 11 | 12 | = JPGALGO.TXT = 13 | Good summary 14 | -------------------------------------------------------------------------------- /docs/png/libmich: -------------------------------------------------------------------------------- 1 | git clone https://github.com/mitshell/libmich.git 2 | -------------------------------------------------------------------------------- /docs/ssh/index.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/docs/ssh/index.txt -------------------------------------------------------------------------------- /docs/tls/index.txt: -------------------------------------------------------------------------------- 1 | - IANA TLS parameters 2 | * http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.xml 3 | * http://www.iana.org/assignments/tls-parameters/tls-parameters.xml 4 | - TLS RFCs 5 | * TLS v1.2 : rfc5246 6 | * TLS v1.1 : rfc4346 7 | * TLS v1.0 : rfc2246 8 | * TLS Extensions : rfc{3546,4366,6066} 9 | * TLS Compression methods : rfc3749 10 | * TLS Supplemental Data : rfc4680 11 | * Million Message Attack : rfc3218.txt 12 | * SEED : rfc4162 13 | * DES/IDEA : rfc5469 14 | * GCM : rfc5288 15 | * PSK Cipher Suites for TLS : rfc{4279,5487,5489} 16 | * KRB : rfc2712 17 | * SRP : rfc5054 18 | * ECC Cipher Suites for TLS : rfc{4492,5289} 19 | * Camellia : rfc{5932,6367} 20 | * ARIA : rfc6209 21 | * PKCS#1.5 : rfc3447 22 | * HMAC : rfc2104 23 | * OCSP : rfc2560 24 | * X509 : rfc{3280,5280,3039,3279,3739,4055} 25 | * SSLv3 : http://www.mozilla.org/projects/security/pki/nss/ssl/draft302.txt, rfc 6101 26 | * SSLv2 : http://www.mozilla.org/projects/security/pki/nss/ssl/draft02.html 27 | * PGP : rfc6091 28 | * DTLS : rfc{4347,6347} 29 | * Secure renegotiation : rfc5746 30 | * Heartbeat : rfc6520 31 | * Session Ticket : rfc4507 32 | -------------------------------------------------------------------------------- /formats/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /formats/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal File formats library" 3 | requires = "unix str cryptokit camlp4 parsifal_syntax parsifal_core" 4 | archive(byte) = "parsifal_formats.cma" 5 | archive(native) = "parsifal_formats.cmxa" 6 | exists_if = "parsifal_formats.cma" 7 | -------------------------------------------------------------------------------- /formats/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = 3 | MLLIBS = parsifal_formats 4 | LIBNAME = parsifal_formats 5 | 6 | parsifal_formats_SRCS := guid.ml pe.ml tar.ml png.ml dvi.ml uefi_fv.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix str zarith cryptokit parsifal_syntax parsifal_core parsifal_net parsifal_crypto 16 | 17 | # use the following variables to add extra flags (not guessed by ocamlfind) 18 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLOPT_LD_FLAGS = -I build mylzma.cmxa mytiano.cmxa 20 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 21 | # XXX we add the .cma here to force it appear *before* uefi_fv (see end of this file) 22 | EXTRA_OCAMLC_LD_FLAGS = build/mylzma.cma build/mytiano.cma 23 | EXTRA_CMXA_LD_FLAGS = build/lzma.cmx build/tiano.cmx 24 | 25 | BUILD_DIR = build 26 | 27 | include ../Makefile.ocaml 28 | 29 | build/unlzma.o: unlzma.c unlzma.h 30 | $(CC) -o $@ -c -g -fPIC $< 31 | 32 | build/lzma_stubs.o: lzma_stubs.c unlzma.h 33 | $(OCAMLC) -c -g $< && mv $(@F) $@ 34 | 35 | build/libmylzma.a: build/lzma_stubs.o build/unlzma.o build/lzma.cmx 36 | ocamlmklib -o mylzma -Lbuild/ $^ && \ 37 | mv libmylzma.a dllmylzma.so mylzma.a mylzma.cmxa build/ 38 | 39 | build/dllmylzma.so: build/libmylzma.a 40 | build/mylzma.a: build/libmylzma.a 41 | build/mylzma.cmxa: build/libmylzma.a 42 | 43 | build/mylzma.cma: build/lzma.cmo build/dllmylzma.so 44 | $(OCAMLC) -a -o $@ $< -dllib -lmylzma -cclib -lmylzma -ccopt -Lbuild/ -I build/ 45 | 46 | build/EfiTianoDecompress.o: EfiTianoDecompress.c EfiTianoDecompress.h basetypes.h 47 | $(CC) -o $@ -c -g -fPIC $< 48 | 49 | build/tiano_stubs.o: tiano_stubs.c EfiTianoDecompress.h basetypes.h 50 | $(OCAMLC) -c -g $< && mv $(@F) $@ 51 | 52 | build/libmytiano.a: build/tiano_stubs.o build/EfiTianoDecompress.o build/tiano.cmx 53 | ocamlmklib -o mytiano -Lbuild/ $^ && \ 54 | mv libmytiano.a dllmytiano.so mytiano.a mytiano.cmxa build/ 55 | 56 | build/dllmytiano.so: build/libmytiano.a 57 | build/mytiano.a: build/libmytiano.a 58 | build/mytiano.cmxa: build/libmytiano.a 59 | 60 | build/mytiano.cma: build/tiano.cmo build/dllmytiano.so 61 | $(OCAMLC) -a -o $@ $< -dllib -lmytiano -cclib -lmytiano -ccopt -Lbuild/ -I build/ 62 | 63 | # extra dependencies 64 | build/lzma.cmo: build/lzma.cmi 65 | build/lzma.cmx: build/lzma.cmi 66 | 67 | build/tiano.cmo: build/tiano.cmi 68 | build/tiano.cmx: build/tiano.cmi 69 | 70 | # XXX problem: the .cma file here is added *after* uefi_fv 71 | build/parsifal_formats.cma: build/mylzma.cma build/mytiano.cma 72 | # XXX problem: the .cmx file here is added *after* uefi_fv 73 | build/parsifal_formats.cmxa: 74 | -------------------------------------------------------------------------------- /formats/dex.ml.TODO: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | 3 | exception Pouet 4 | 5 | let check_header_size = function 6 | | 0x70 -> () 7 | | _ -> raise Pouet 8 | 9 | (* TODO: Auto-generate little and big endian variants when asked *) 10 | 11 | 12 | struct file_content = { 13 | header_size : uint32; 14 | check_header_size : check of check_header_size (header_size); 15 | endian_tag : 16 | } 17 | 18 | struct header_item [top] = { 19 | magic : magic ("dex\n035\0x00"); 20 | checksum : uint32; 21 | signature : binstring(20); 22 | file_size : uint32; 23 | file_content : container(file_size - 36) of file_content; 24 | } 25 | -------------------------------------------------------------------------------- /formats/lzma.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | 4 | external lzma_getsize: string -> int -> int = "caml_lzma_getsize" 5 | 6 | external lzma_decode: string -> int -> bytes -> int -> int = "caml_lzma_decode" 7 | 8 | type 'a lzma_container = 'a 9 | 10 | let parse_lzma_container name parse_fun input = 11 | let buf = parse_rem_string input in 12 | let length = String.length buf in 13 | let dst_size = lzma_getsize buf length in 14 | let dst = Bytes.create dst_size in 15 | let ret = lzma_decode buf length dst dst_size in 16 | if ret <> 0 then raise (Failure "LZMA decompression error"); 17 | let new_input = get_in_container input name (Bytes.to_string dst) in (* TODO: Use unsafe_to_string? *) 18 | let res = parse_fun new_input in 19 | check_empty_input true new_input; 20 | res 21 | 22 | let dump_lzma_container _ _buf _ = failwith "dump_lzma_container not implemented" 23 | 24 | let value_of_lzma_container = value_of_container 25 | -------------------------------------------------------------------------------- /formats/lzma.mli: -------------------------------------------------------------------------------- 1 | external lzma_getsize: string -> int -> int = "caml_lzma_getsize" 2 | 3 | (* lzma_decode src src_size dst dst_size -> 0 if success 4 | * dst must be of size dst_size, and must be big enough 5 | *) 6 | external lzma_decode: string -> int -> bytes -> int -> int = "caml_lzma_decode" 7 | 8 | type 'a lzma_container = 'a 9 | val parse_lzma_container : 10 | string -> (Parsifal.string_input -> 'a) -> Parsifal.string_input -> 'a 11 | val dump_lzma_container : 'a -> 'b -> 'c -> 'd 12 | val value_of_lzma_container : ('a -> 'b) -> 'a -> 'b 13 | 14 | -------------------------------------------------------------------------------- /formats/lzma_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | #include "unlzma.h" 14 | 15 | static void error(char *s) 16 | { 17 | fprintf(stderr, "ERROR %s\n", s); 18 | exit(1); 19 | } 20 | 21 | CAMLprim value caml_lzma_getsize(value buf, value buf_size) 22 | { 23 | unsigned char *c_src = (unsigned char *)String_val(buf); 24 | long c_src_size = caml_string_length(buf); 25 | int ret; 26 | int out_len; 27 | 28 | ret = unlzma(c_src, c_src_size, NULL, NULL, NULL, &out_len, NULL, error); 29 | if (ret == 0) 30 | return Val_long(out_len); 31 | return Val_long(-1); 32 | } 33 | 34 | CAMLprim value caml_lzma_decode(value src, value src_size, value dst, value dst_size) 35 | { 36 | unsigned char *c_src = (unsigned char *)String_val(src); 37 | long c_src_size = caml_string_length(src); 38 | unsigned char *c_dst = (unsigned char *)String_val(dst); 39 | long c_dst_size = Long_val(dst_size); 40 | 41 | //printf("uncompressing (c_src_size: %ld -> c_dst_size: %ld)\n", c_src_size, c_dst_size); 42 | unlzma(c_src, c_src_size, NULL, NULL, c_dst, (int*)&c_dst_size, NULL, error); 43 | 44 | return Val_long(0); 45 | } 46 | 47 | -------------------------------------------------------------------------------- /formats/tar.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | (* TODO: Mark ustar as one possible extra header *) 6 | 7 | enum file_type (8, UnknownVal UnknownFileType) = 8 | | 0x30 | 0 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | (* TODO: change stg to get len in here? *) 30 | let value_of_tar_numstring i = VInt i 31 | 32 | 33 | union optional_tar_numstring [both_param len; enrich] (UnparsedNum of binstring(len)) = 34 | | CharacterSpecial -> Num of tar_numstring(BOTH len) 35 | | BlockSpecial -> Num of tar_numstring(BOTH len) 36 | 37 | 38 | struct ustar_header [param file_type] = { 39 | ustar_magic : magic("ustar"); 40 | _ustar_magic_padding : binstring(3); 41 | owner_user : nt_string(BOTH 32); 42 | owner_group : nt_string(BOTH 32); 43 | device_major : optional_tar_numstring(BOTH 8; file_type); 44 | device_minor : optional_tar_numstring(BOTH 8; file_type); 45 | filename_prefix : nt_string(BOTH 155) 46 | } 47 | 48 | struct tar_header = { 49 | file_name : nt_string(BOTH 100); 50 | parse_checkpoint : stop_if(file_name = ""); 51 | file_mode : tar_numstring(BOTH 8); 52 | owner_uid : tar_numstring(BOTH 8); 53 | owner_gid : tar_numstring(BOTH 8); 54 | file_size : tar_numstring(BOTH 12); 55 | timestamp : tar_numstring(BOTH 12); 56 | checksum : string(8); 57 | file_type : file_type; 58 | linked_file : nt_string(BOTH 100); 59 | optional ustar_header : ustar_header(file_type); 60 | _hdr_padding : binstring 61 | } 62 | 63 | 64 | (* let check_crc32 _hdr _content _padding = () *) 65 | 66 | let padding_size file_size = 67 | (512 - (file_size mod 512)) mod 512 68 | 69 | struct tar_entry = { 70 | header : container(512) of tar_header; 71 | file_content : binstring(header.file_size); 72 | file_padding : binstring(padding_size header.file_size) 73 | (* checksum_verification : check of check_crc32 (header, *) 74 | (* file_content, file_padding); *) 75 | } 76 | 77 | alias tar_file = list of tar_entry 78 | -------------------------------------------------------------------------------- /formats/test/.gitignore: -------------------------------------------------------------------------------- 1 | test_tar 2 | test_tar.byte 3 | test_pe 4 | test_pe.byte 5 | test_dvi 6 | test_dvi.byte 7 | test_uefi_fv 8 | test_uefi_fv.byte 9 | -------------------------------------------------------------------------------- /formats/test/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_tar test_pe test_dvi test_uefi_fv 3 | 4 | test_tar_SRCS := test_tar.ml 5 | test_pe_SRCS := test_pe.ml 6 | test_dvi_SRCS := test_dvi.ml 7 | test_uefi_fv_SRCS := test_uefi_fv.ml 8 | 9 | # comment this line if not using camlp4 10 | USE_CAMLP4 = yes 11 | 12 | CC = gcc 13 | 14 | # use the following lines to guess .cmxa files from libs names. 15 | # remember, libs are always lowercase 16 | OCAML_LIBS = unix lwt lwt.unix str calendar zarith result cryptokit \ 17 | parsifal_syntax parsifal_core parsifal_lwt \ 18 | parsifal_crypto parsifal_formats 19 | 20 | # use the following variables to add extra flags (not guessed by ocamlfind) 21 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 22 | EXTRA_OCAMLOPT_LD_FLAGS = -cclib -lmylzma -cclib -lmytiano -ccopt -Lbuild/ 23 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 24 | EXTRA_OCAMLC_LD_FLAGS = 25 | 26 | BUILD_DIR = build 27 | 28 | 29 | 30 | include ../../Makefile.ocaml 31 | 32 | 33 | check: all 34 | -------------------------------------------------------------------------------- /formats/test/test_dvi.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Dvi 3 | 4 | 5 | let extract_char buf = function 6 | | { command = DVIString (_, s) } -> Buffer.add_string buf s 7 | | { command = Right3 r } when r > 0x10000 -> Buffer.add_char buf ' ' 8 | | { command = Down3 _ } -> Buffer.add_char buf '\n' 9 | | { command = EndOfPage } -> Buffer.add_string buf "\n\n" 10 | | _ -> () 11 | 12 | 13 | let rec simplify = function 14 | | [] -> [] 15 | | { command = DVIString (_, "\x1b") }::r -> { opcode = OP_Opcode (-1); command = DVIString (-1, "ff") }::(simplify r) 16 | | { command = DVIString (_, "\x1c") }::r -> { opcode = OP_Opcode (-1); command = DVIString (-1, "fi") }::(simplify r) 17 | | { command = NoOperation }::r -> simplify r 18 | | { command = Right3 right }::r when right > 0x10000 -> 19 | { opcode = OP_Opcode (-1); command = DVIString (-1, " ") }::(simplify r) 20 | | { command = (W0|W1 _|W2 _|W3 _|W4 _|X0|X1 _|X2 _|X3 _|X4 _) }::r -> 21 | { opcode = OP_Opcode (-1); command = DVIString (-1, " ") }::(simplify r) 22 | | { command = Right3 _ }::r -> simplify r 23 | | x::r -> x::(simplify r) 24 | 25 | let rec merge_chars = function 26 | | [] -> [] 27 | | { command = DVIString (_, s1) }::{ command = DVIString (_, s2) }::r -> 28 | merge_chars ({ opcode = OP_Opcode (-1); command = DVIString (-1, s1 ^ s2) }::r) 29 | | x::r -> x::(merge_chars r) 30 | 31 | let simplify_dvi l = merge_chars (simplify l) 32 | 33 | let string_of_command_type = function 34 | | { command = DVIString _ } -> "string" 35 | | { opcode = o } -> string_of_opcode o 36 | 37 | let print_dvi_command c = 38 | print_string (print_value ~name:(string_of_command_type c) (value_of_dvi_command_detail c.command)) 39 | 40 | let _ = 41 | let input = string_input_of_filename Sys.argv.(1) in 42 | let dvi = parse_dvi_file input in 43 | print_endline "= RAW DVI file ="; 44 | List.iter print_dvi_command dvi; 45 | (* let buf = Buffer.create 1024 in 46 | List.iter (extract_char buf) dvi; 47 | print_endline (Buffer.contents buf); 48 | print_endline (print_value (value_of_dvi_file (simplify_dvi dvi))); *) 49 | print_endline "\n\n= \"Simplified\" DVI file ="; 50 | List.iter print_dvi_command (simplify_dvi dvi) 51 | 52 | -------------------------------------------------------------------------------- /formats/test/test_pe.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open LwtUtil 3 | open Parsifal 4 | open Pe 5 | open Getopt 6 | open PTypes 7 | 8 | let options = [ 9 | mkopt (Some 'h') "help" Usage "show this help"; 10 | ] 11 | 12 | let parse_secdir_entry filename entry = 13 | let s = get_file_content filename in 14 | let input = input_of_string "SecDir Entry" s in 15 | parse_seek_offset entry.virtualaddress input; 16 | let win_crt = parse_win_certificate input in 17 | print_endline (print_value (value_of_win_certificate win_crt)); 18 | return () 19 | 20 | 21 | let parse_file filename = 22 | input_of_filename filename >>= lwt_parse_wrapper parse_pe_file >>= fun pe_file -> 23 | print_endline (print_value (value_of_pe_file pe_file)); 24 | let secdir_entry = pe_file.optpe_header.datadirectory.(4) in 25 | print_endline (print_value (value_of_data_directory_entry secdir_entry)); 26 | return () 27 | >>= fun _ -> 28 | print_endline "blah\n"; 29 | let t = parse_secdir_entry filename secdir_entry in 30 | Lwt.join [t] >>= fun _ -> (); 31 | return () 32 | 33 | 34 | let main = 35 | try 36 | let args = parse_args ~progname:"test_pe" options Sys.argv in 37 | let t = match args with 38 | | [filename] -> parse_file filename 39 | | _ -> usage "test_pe" options (Some "Please provide exactly one filename.") 40 | in Lwt_main.run t; 41 | with 42 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 43 | | e -> prerr_endline (Printexc.to_string e); exit 1 44 | 45 | let _ = main 46 | -------------------------------------------------------------------------------- /formats/test/test_tar.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open LwtUtil 3 | open Parsifal 4 | open Tar 5 | open Getopt 6 | 7 | type action = NoAction | Test | Create | Extract 8 | 9 | let verbose = ref false 10 | let archive = ref "" 11 | let action = ref NoAction 12 | 13 | 14 | let options = [ 15 | mkopt (Some 'h') "help" Usage "show this help"; 16 | mkopt (Some 'v') "verbose" (Set verbose) "talk more"; 17 | 18 | mkopt (Some 't') "test" (TrivialFun (fun () -> action := Test)) "checks the archive"; 19 | mkopt (Some 'c') "create" (TrivialFun (fun () -> action := Test)) "create an archive"; 20 | mkopt (Some 'x') "extract" (TrivialFun (fun () -> action := Test)) "extract an archive"; 21 | 22 | mkopt (Some 'f') "file" (StringVal archive) "name of the archive to consider" 23 | ] 24 | 25 | 26 | let string_of_file_type = function 27 | | SymbolicLink -> 'l' 28 | | CharacterSpecial -> 'c' 29 | | BlockSpecial -> 'b' 30 | | Directory -> 'd' 31 | | FIFO -> 'p' 32 | | NormalFile 33 | | HardLink 34 | | ContiguousFile 35 | | UnknownFileType _ -> '-' 36 | 37 | let string_of_right right = 38 | (if right land 4 <> 0 then "r" else "-") ^ 39 | (if right land 2 <> 0 then "w" else "-") ^ 40 | (if right land 1 <> 0 then "x" else "-") 41 | 42 | let string_of_nts s = 43 | try 44 | let pos = String.index s '\x00' in 45 | String.sub s 0 pos 46 | with Not_found -> s 47 | 48 | let string_of_user entry = 49 | match entry.ustar_header with 50 | | None -> string_of_int entry.owner_uid 51 | | Some h -> string_of_nts h.owner_user 52 | 53 | let string_of_group entry = 54 | match entry.ustar_header with 55 | | None -> string_of_int entry.owner_gid 56 | | Some h -> string_of_nts h.owner_group 57 | 58 | 59 | let print_entry entry = 60 | let header = entry.header in 61 | Printf.printf "%c%s%s%s %s/%s %d %s\n" 62 | (string_of_file_type header.file_type) 63 | (string_of_right ((header.file_mode lsr 6) land 7)) 64 | (string_of_right ((header.file_mode lsr 3) land 7)) 65 | (string_of_right (header.file_mode land 7)) 66 | (string_of_user header) (string_of_group header) 67 | header.file_size header.file_name 68 | 69 | 70 | let check_archive filename = 71 | input_of_filename filename >>= lwt_parse_wrapper parse_tar_file >>= fun tar_file -> 72 | if !verbose 73 | then List.iter print_entry tar_file; 74 | return () 75 | 76 | 77 | let _ = 78 | try 79 | let args = parse_args ~progname:"test_tar" options Sys.argv in 80 | let t = 81 | if !archive == "" 82 | then fail (Failure "Please specify an archive name (--file)") 83 | else begin 84 | match !action, args with 85 | | Test, [] -> check_archive !archive 86 | | Test, _ -> fail (Failure "--test does not need arguments") 87 | | Create, _ -> fail (ParsingException (NotImplemented "--create", [])) 88 | | Extract, _ -> fail (ParsingException (NotImplemented "--extract", [])) 89 | | NoAction, _ -> fail (Failure "Please give an action (--test, --create or --extract)") 90 | end 91 | in 92 | Lwt_main.run t; 93 | with 94 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 95 | | e -> prerr_endline (Printexc.to_string e); exit 1 96 | 97 | -------------------------------------------------------------------------------- /formats/tiano.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | 4 | external tiano_getsize: string -> int -> int = "caml_tiano_getsize" 5 | 6 | external tiano_decode: string -> int -> bytes -> int -> int = "caml_tiano_decode" 7 | 8 | type 'a tiano_container = 'a 9 | 10 | let parse_tiano_container name parse_fun input = 11 | let buf = parse_rem_string input in 12 | let length = String.length buf in 13 | let dst_size = tiano_getsize buf length in 14 | let dst = Bytes.create dst_size in 15 | let ret = tiano_decode buf length dst dst_size in 16 | if ret <> 0 then raise (Failure "Tiano decompression error"); 17 | let new_input = get_in_container input name (Bytes.to_string dst) in (* TODO: Use unsafe_to_string? *) 18 | let res = parse_fun new_input in 19 | check_empty_input true new_input; 20 | res 21 | 22 | let dump_tiano_container _ _buf _ = failwith "dump_tiano_container not implemented" 23 | 24 | let value_of_tiano_container = value_of_container 25 | -------------------------------------------------------------------------------- /formats/tiano.mli: -------------------------------------------------------------------------------- 1 | external tiano_getsize: string -> int -> int = "caml_tiano_getsize" 2 | 3 | (* tiano_decode src src_size dst dst_size -> 0 if success 4 | * dst must be of size dst_size, and must be big enough 5 | *) 6 | external tiano_decode: string -> int -> bytes -> int -> int = "caml_tiano_decode" 7 | 8 | type 'a tiano_container = 'a 9 | val parse_tiano_container : 10 | string -> (Parsifal.string_input -> 'a) -> Parsifal.string_input -> 'a 11 | val dump_tiano_container : 'a -> 'b -> 'c -> 'd 12 | val value_of_tiano_container : ('a -> 'b) -> 'a -> 'b 13 | 14 | -------------------------------------------------------------------------------- /formats/tiano_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | #include "EfiTianoDecompress.h" 14 | 15 | /* static void error(char *s) 16 | { 17 | fprintf(stderr, "ERROR %s\n", s); 18 | exit(1); 19 | } */ 20 | 21 | CAMLprim value caml_tiano_getsize(value buf, value buf_size) 22 | { 23 | unsigned char *c_src = (unsigned char *)String_val(buf); 24 | long c_src_size = caml_string_length(buf); 25 | //int ret; 26 | //int out_len; 27 | //UINT8* scratch; 28 | UINT32 scratchSize = 0; 29 | UINT32 decompressedSize = 0; 30 | EFI_TIANO_HEADER* header; 31 | 32 | header = (EFI_TIANO_HEADER*) c_src; 33 | if (header->CompSize + sizeof(EFI_TIANO_HEADER) != c_src_size) 34 | return Val_long(-1); 35 | 36 | if (ERR_SUCCESS != EfiTianoGetInfo(c_src, c_src_size, &decompressedSize, &scratchSize)) 37 | return Val_long(-2); 38 | 39 | //scratch = malloc(scratchSize); 40 | //fprintf(stdout, "tiano_getsize: %ld\n", decompressedSize); 41 | 42 | return Val_long(decompressedSize); 43 | } 44 | 45 | CAMLprim value caml_tiano_decode(value src, value src_size, value dst, value dst_size) 46 | { 47 | UINT8* scratch; 48 | UINT32 scratchSize = 0; 49 | UINT32 decompressedSize = 0; 50 | EFI_TIANO_HEADER* header; 51 | unsigned char *c_src = (unsigned char *)String_val(src); 52 | long c_src_size = caml_string_length(src); 53 | unsigned char *c_dst = (unsigned char *)String_val(dst); 54 | long c_dst_size = Long_val(dst_size); 55 | 56 | //printf("uncompressing (c_src_size: %ld -> c_dst_size: %ld)\n", c_src_size, c_dst_size); 57 | 58 | header = (EFI_TIANO_HEADER*) c_src; 59 | if (header->CompSize + sizeof(EFI_TIANO_HEADER) != c_src_size) 60 | return Val_long(-1); 61 | 62 | if (ERR_SUCCESS != EfiTianoGetInfo(c_src, c_src_size, &decompressedSize, &scratchSize)) 63 | return Val_long(-2); 64 | 65 | if (c_dst_size < decompressedSize) 66 | return Val_long(-3); 67 | 68 | scratch = malloc(scratchSize); 69 | 70 | if (ERR_SUCCESS != TianoDecompress(c_src, c_src_size, c_dst, decompressedSize, scratch, scratchSize)) 71 | return Val_long(-4); 72 | //untiano(c_src, c_src_size, NULL, NULL, c_dst, (int*)&c_dst_size, NULL, error); 73 | 74 | free(scratch); 75 | return Val_long(0); 76 | } 77 | 78 | -------------------------------------------------------------------------------- /formats/unlzma.h: -------------------------------------------------------------------------------- 1 | #ifndef DECOMPRESS_UNLZMA_H 2 | #define DECOMPRESS_UNLZMA_H 3 | 4 | int unlzma(unsigned char *, int, 5 | int(*fill)(void*, unsigned int), 6 | int(*flush)(void*, unsigned int), 7 | unsigned char *output, 8 | int *out_len, 9 | int *posp, 10 | void(*error)(char *x) 11 | ); 12 | 13 | #endif 14 | -------------------------------------------------------------------------------- /issues.txt: -------------------------------------------------------------------------------- 1 | #Milestone Issue Description Status Assignee Labels 2 | v0.2 1 Describe TAR step by step open yeye doc 3 | v0.2 2 Describe PNG step by step open yeye doc 4 | v0.2 3 Describe DNS step by step open yeye doc 5 | v0.2 4 Write a tutorial open yeye doc 6 | v0.2 5 Create a Changelog closed yeye doc 7 | v0.2 6 Described the formats and protocols implemented closed yeye doc 8 | v0.2 13 Debug features: use container real names closed yeye stdlib,enhancement 9 | v0.2 15 Add string_input_of_stdin closed yeye stdlib,enhancement 10 | v0.2 18 A README would be nice closed yeye doc 11 | v0.2 19 An INSTALL would be nice closed yeye doc 12 | 13 | NoLwt 20 Remove Lwt specific code from the preprocessor/stdlib closed yeye preprocessor,stdlib 14 | NoLwt 21 Create a Lwt wrapper to handle stream parsing open yeye stdlib 15 | NoLwt 31 OOB exception should return a hint on the exp. length open yeye stdlib 16 | 17 | v0.3 7 Write a white paper open yeye doc 18 | v0.3 8 Write some HTML to provide a decent website open yeye doc 19 | v0.3 9 Create a mailing list open yeye 20 | v0.3 10 New option "prefix" for enum/union constructors open yeye preprocessor,enhancement 21 | v0.3 11 Allow for more flexible enum patterns closed yeye preprocessor,enhancement 22 | v0.3 12 Allow direct access to fields in dump functions open yeye preprocessor,bug 23 | v0.3 16 Debug features: give better info on partial parsings open yeye preprocessor,enhancement 24 | v0.3 17 Debug features: add an hex tool to interpret histories open yeye enhancement 25 | 26 | UNIT 22 Write unit tests for parsifal_syntax open yeye tests 27 | UNIT 23 Write unit tests for parsifal_core open yeye tests 28 | UNIT 24 Generic framework to test format/protocol descriptions open yeye tests 29 | 30 | REC 25 Rewrite the internal structure handling PTypes open yeye preprocessor,enhancement 31 | REC 26 Use string_of_t function when available in value_of open yeye preprocessor,enhancement 32 | REC 27 Allow for partial function overload in PType defintion open yeye preprocessor,enhancement 33 | REC 28 Create a new "depend" option to explicit dependencies open yeye preprocessor,enhancement 34 | REC 29 New "custom" construction open yeye preprocessor,enhancement 35 | REC 30 Add support in the preprocessor for recursive types open yeye preprocessor,enhancement 36 | 37 | - 14 Allow for non-constant constructors in enum open yeye preprocessor,enhancement 38 | - 32 Support of pcapng open yeye enhancement 39 | - 33 SSL/TLS client open yeye enhancement 40 | - 34 SSL/TLS server open yeye enhancement 41 | - 35 Parsifal does not compile on 32-bit systems open yeye bug,stdlib 42 | 43 | - ?? Handle BER/DER correctly open yeye bug,stdlib,preprocessor 44 | -------------------------------------------------------------------------------- /kerby/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /kerby/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal Kerberos library" 3 | requires = "unix str cryptokit camlp4 parsifal_syntax parsifal_core parsifal_net parsifal_ssl" 4 | archive(byte) = "parsifal_kerby.cma" 5 | archive(native) = "parsifal_kerby.cmxa" 6 | exists_if = "parsifal_kerby.cma" 7 | -------------------------------------------------------------------------------- /kerby/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | MLLIBS = parsifal_kerby 3 | LIBNAME = parsifal_kerby 4 | 5 | parsifal_kerby_SRCS := krb5.ml kerbyContainers.ml pac.ml kerberosTypes.ml padata.ml kerby.ml keytab.ml 6 | 7 | # comment this line if not using camlp4 8 | USE_CAMLP4 = yes 9 | 10 | CC = gcc 11 | 12 | # use the following lines to guess .cmxa files from libs names. 13 | # remember, libs are always lowercase 14 | OCAML_LIBS = unix str zarith cryptokit parsifal_syntax parsifal_core parsifal_net parsifal_crypto 15 | 16 | CAMLIDL_DIR = `$(OCAMLFIND) query camlidl` 17 | STDLIB_DIR = `$(OCAMLFIND) query stdlib` 18 | 19 | # use the following variables to add extra flags (not guessed by ocamlfind) 20 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLOPT_LD_FLAGS = build/krb5_stubs.o build/krb5_functions.o -cclib -lkrb5 -cclib -lk5crypto -ccopt "-L $(CAMLIDL_DIR)" -cclib -lcamlidl 22 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 23 | EXTRA_OCAMLC_LD_FLAGS = -custom build/krb5_stubs.o build/krb5_functions.o -cclib -lkrb5 -cclib -lk5crypto -ccopt "-L $(CAMLIDL_DIR)" -cclib -lcamlidl 24 | 25 | BUILD_DIR = build 26 | 27 | 28 | include ../Makefile.ocaml 29 | 30 | 31 | build/krb5_stubs.o: krb5_stubs.c 32 | gcc -DDEBUG -Wall -I$(CAMLIDL_DIR) -I$(STDLIB_DIR) -c -o $@ $< 33 | 34 | build/krb5_functions.o: krb5_functions.c 35 | gcc -DDEBUG -Wall -I$(CAMLIDL_DIR) -I$(STDLIB_DIR) -c -o $@ $< 36 | 37 | build/krb5.cmo: build/krb5_stubs.o build/krb5_functions.o 38 | build/krb5.cmx: build/krb5_stubs.o build/krb5_functions.o 39 | 40 | -------------------------------------------------------------------------------- /kerby/kerbyContainers.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Cryptokit 3 | open BasePTypes 4 | open Krb5 5 | 6 | type 'a crypto_container = Encrypted of binstring | Decrypted of 'a | DecryptionError 7 | 8 | let value_of_crypto_container value_of_fun = function 9 | | Encrypted s -> VUnparsed (VString (s, true)) 10 | | Decrypted x -> VAlias ("crypto_container", value_of_fun x) 11 | | DecryptionError -> VUnparsed (VString ("DECRYPTION ERROR", false)) 12 | 13 | 14 | (* UGLY AES *) 15 | let byte_array_to_string = fun a -> let s = Bytes.create (Array.length a) in 16 | Array.iteri (fun i x -> Bytes.set s i x) a; s;; 17 | 18 | let string_to_byte_array = fun s -> Array.init (String.length s) (fun i-> s.[i]);; 19 | 20 | let aes_decrypt usage kvno ciphertext session_key = 21 | let aes_keyblock = { 22 | Krb5._mykrb5_keyblock_magic = -1760647421; 23 | Krb5._mykrb5_keyblock_enctype = 18; 24 | Krb5._mykrb5_keyblock_contents = string_to_byte_array session_key 25 | } in 26 | let enc_data = { 27 | Krb5._mykrb5_data_magic = 0 ; 28 | Krb5._mykrb5_data_data = string_to_byte_array ciphertext 29 | } in 30 | let enc_structure = { 31 | Krb5._mykrb5_enc_data_magic = -1760647418; 32 | Krb5._mykrb5_enc_data_enctype = 18; 33 | Krb5._mykrb5_enc_data_kvno = pop_opt 0 kvno; 34 | Krb5._mykrb5_enc_data_ciphertext = enc_data 35 | } in 36 | let (_, decrypted) = mL_krb5_c_decrypt aes_keyblock usage enc_structure in 37 | (byte_array_to_string decrypted.Krb5._mykrb5_data_data) 38 | 39 | type 'a aes_container = 'a crypto_container 40 | 41 | let parse_aes_container usage kvno aes_key name parse_fun input = 42 | let s = parse_rem_string input in 43 | match aes_key with 44 | | None -> Encrypted s 45 | | Some k -> 46 | try 47 | let decrypted_s = aes_decrypt usage kvno s k in 48 | let new_input = get_in_container input name (Bytes.to_string decrypted_s) in (* TODO: Use unsafe_to_string? *) 49 | let res = parse_fun new_input in 50 | check_empty_input true new_input; 51 | Decrypted res 52 | with _ -> Encrypted s 53 | 54 | let dump_aes_container _dump_fun _o = failwith "Pouet" 55 | 56 | let value_of_aes_container = value_of_crypto_container 57 | 58 | 59 | (* UGLY DES3 *) 60 | let des3_decrypt ciphertext iv des3_key = 61 | let mydes_decrypt = Cryptokit.Cipher.triple_des ~mode:Cryptokit.Cipher.CBC ~pad:Cryptokit.Padding.length ~iv:iv (des3_key) Cryptokit.Cipher.Decrypt in 62 | transform_string mydes_decrypt ciphertext 63 | 64 | 65 | type 'a des3_container = 'a crypto_container 66 | 67 | let parse_des3_container opt_iv des3_key name parse_fun input = 68 | let s = parse_rem_string input in 69 | match opt_iv, des3_key with 70 | | Some (X509Basics.DES3Params iv), Some k -> 71 | let decrypted_s = des3_decrypt s iv k in 72 | let new_input = get_in_container input name decrypted_s in 73 | let res = parse_fun new_input in 74 | check_empty_input true new_input; 75 | Decrypted res 76 | | _ -> Encrypted s 77 | 78 | let dump_des3_container _dump_fun _o = not_implemented "dump_des3_container" 79 | 80 | let value_of_des3_container = value_of_crypto_container 81 | 82 | 83 | -------------------------------------------------------------------------------- /kerby/keytab.ml: -------------------------------------------------------------------------------- 1 | open BasePTypes 2 | 3 | enum etype_type (16, UnknownVal UnknownEncryptType) = 4 | | 1 -> DES_CBC_CRC 5 | | 2 -> DES_CBC_MD4 6 | | 3 -> DES_CBC_MD5 7 | | 5 -> DES3_CBC_MD5 8 | | 16 -> DES3_CBC_SHA1 9 | | 17 -> AES128_CTS_HMAC_SHA1_96 10 | | 18 -> AES256_CTS_HMAC_SHA1_96 11 | | 23 -> RC4_HMAC 12 | | 24 -> RC4_HMAC_EXP 13 | | 25 -> CAMELLIA128_CTS_CMAC 14 | | 26 -> CAMELLIA256_CTS_CMAC 15 | 16 | enum name_type (32, UnknownVal UnknownNameType) = 17 | | 1 -> KRB5_NT_PRINCIPAL, "KRB5_NT_PRINCIPAL" 18 | | 2 -> KRB5_NT_SRV_INST, "KRB5_SRV_INST" 19 | | 5 -> KRB5_NT_UID, "KRB5_NT_UID" 20 | 21 | alias counted_octet_string = string[uint16] 22 | struct keyblock = { 23 | etype : etype_type; 24 | key : binstring[uint16] 25 | } 26 | 27 | struct keytab_entry = 28 | { 29 | num_components: uint16; (* sub 1 if version 0x501 *) 30 | realm : counted_octet_string (* counted_octet_string *); 31 | components : list(num_components) of counted_octet_string; 32 | optional name_type: name_type; (* not present if version 0x501 *) 33 | timestamp: uint32; 34 | vno8 : uint8; 35 | key : keyblock (* keyblock *); 36 | optional vno : uint32; (* only present if >= 4 bytes left in entry *) 37 | } 38 | 39 | struct keytab_file = 40 | { 41 | file_format_version : uint16; 42 | entries : list of container[uint32] of keytab_entry; 43 | } 44 | -------------------------------------------------------------------------------- /kerby/krb5.h: -------------------------------------------------------------------------------- 1 | /* File generated from krb5.idl */ 2 | 3 | #ifndef _CAMLIDL_KRB5_H 4 | #define _CAMLIDL_KRB5_H 5 | 6 | #ifdef __cplusplus 7 | #define _CAMLIDL_EXTERN_C extern "C" 8 | #else 9 | #define _CAMLIDL_EXTERN_C extern 10 | #endif 11 | 12 | #ifdef _WIN32 13 | #pragma pack(push,8) /* necessary for COM interfaces */ 14 | #endif 15 | 16 | struct _mykrb5_keyblock { 17 | int magic; 18 | int enctype; 19 | int length; 20 | char *contents; 21 | }; 22 | 23 | typedef struct _mykrb5_keyblock mykrb5_keyblock; 24 | 25 | struct _mykrb5_data { 26 | int magic; 27 | unsigned int length; 28 | char *data; 29 | }; 30 | 31 | typedef struct _mykrb5_data mykrb5_data; 32 | 33 | struct _mykrb5_enc_data { 34 | int magic; 35 | int enctype; 36 | unsigned int kvno; 37 | mykrb5_data ciphertext; 38 | }; 39 | 40 | typedef struct _mykrb5_enc_data mykrb5_enc_data; 41 | 42 | _CAMLIDL_EXTERN_C int ML_krb5_c_decrypt(/*in*/ mykrb5_keyblock key, /*in*/ int usage, /*in*/ mykrb5_enc_data enc, /*out*/ mykrb5_data *decrypted); 43 | 44 | #ifdef _WIN32 45 | #pragma pack(pop) 46 | #endif 47 | 48 | 49 | #endif /* !_CAMLIDL_KRB5_H */ 50 | -------------------------------------------------------------------------------- /kerby/krb5.ml: -------------------------------------------------------------------------------- 1 | (* File generated from krb5.idl *) 2 | 3 | type _mykrb5_keyblock = { 4 | _mykrb5_keyblock_magic: int; 5 | _mykrb5_keyblock_enctype: int; 6 | _mykrb5_keyblock_contents: char array; 7 | } 8 | and mykrb5_keyblock = _mykrb5_keyblock 9 | and _mykrb5_data = { 10 | _mykrb5_data_magic: int; 11 | _mykrb5_data_data: char array; 12 | } 13 | and mykrb5_data = _mykrb5_data 14 | and _mykrb5_enc_data = { 15 | _mykrb5_enc_data_magic: int; 16 | _mykrb5_enc_data_enctype: int; 17 | _mykrb5_enc_data_kvno: int; 18 | _mykrb5_enc_data_ciphertext: mykrb5_data; 19 | } 20 | and mykrb5_enc_data = _mykrb5_enc_data 21 | 22 | external mL_krb5_c_decrypt : mykrb5_keyblock -> int -> mykrb5_enc_data -> int * mykrb5_data 23 | = "camlidl_krb5_ML_krb5_c_decrypt" 24 | 25 | -------------------------------------------------------------------------------- /kerby/krb5.mli: -------------------------------------------------------------------------------- 1 | (* File generated from krb5.idl *) 2 | 3 | type _mykrb5_keyblock = { 4 | _mykrb5_keyblock_magic: int; 5 | _mykrb5_keyblock_enctype: int; 6 | _mykrb5_keyblock_contents: char array; 7 | } 8 | and mykrb5_keyblock = _mykrb5_keyblock 9 | and _mykrb5_data = { 10 | _mykrb5_data_magic: int; 11 | _mykrb5_data_data: char array; 12 | } 13 | and mykrb5_data = _mykrb5_data 14 | and _mykrb5_enc_data = { 15 | _mykrb5_enc_data_magic: int; 16 | _mykrb5_enc_data_enctype: int; 17 | _mykrb5_enc_data_kvno: int; 18 | _mykrb5_enc_data_ciphertext: mykrb5_data; 19 | } 20 | and mykrb5_enc_data = _mykrb5_enc_data 21 | 22 | external mL_krb5_c_decrypt : mykrb5_keyblock -> int -> mykrb5_enc_data -> int * mykrb5_data 23 | = "camlidl_krb5_ML_krb5_c_decrypt" 24 | 25 | -------------------------------------------------------------------------------- /kerby/krb5_functions.c: -------------------------------------------------------------------------------- 1 | 2 | #include "krb5.h" 3 | #include 4 | #include 5 | #include 6 | 7 | #define MIN(x, y) ((x) < (y) ? (x) : (y)) 8 | //extern int krb5_c_decrypt(void *context, krb5_keyblock *key, int usage, void *cipher_state, krb5_enc_data *enc, krb5_data *plain); 9 | 10 | int ML_krb5_c_decrypt(mykrb5_keyblock key, int usage, mykrb5_enc_data enc, mykrb5_data *decrypted){ 11 | decrypted->length = enc.ciphertext.length; 12 | decrypted->data = malloc(decrypted->length * sizeof (char)); 13 | int rv; 14 | #ifdef HEIMDAL_DEPRECATED 15 | krb5_keyblock keyblock; 16 | 17 | memcpy(&keyblock, &key, MIN(sizeof(keyblock), sizeof(key))); 18 | rv = krb5_c_decrypt(NULL, keyblock, usage, NULL, (krb5_enc_data*)&enc, (krb5_data*)decrypted); 19 | #else 20 | rv = krb5_c_decrypt(NULL, (krb5_keyblock*)&key, usage, NULL, (krb5_enc_data*)&enc, (krb5_data*)decrypted); 21 | #endif 22 | /* 23 | int i; 24 | printf("\nLen: %d\n", decrypted.length); 25 | for(i=0; i&2 9 | echo "Usage: $0 " >&2 10 | exit 1 11 | } 12 | 13 | DESTDIR=$1 14 | PROJECT_NAME="$(basename "$DESTDIR")" 15 | 16 | [ -z "$PARSIFAL_DIR" ] && PARSIFAL_DIR="$(dirname "$PROGNAME")" 17 | 18 | [ -f "$PARSIFAL_DIR/Makefile.ocaml" ] || error "PARSIFAL_DIR variable do not correspond to a directory containing Makefile.ocaml" 19 | [ -f "$PARSIFAL_DIR/Makefile.template" ] || error "PARSIFAL_DIR variable do not correspond to a directory containing Makefile.template" 20 | 21 | [ -n "$DESTDIR" ] || error "Invalid destination directory" 22 | [ -f "$DESTDIR" ] && error "Invalid destination directory ($DESTDIR): file already exists" 23 | [ "$(echo -n "$PROJECT_NAME" | sed 's/^[a-z][a-zA-Z0-9_]*$//g' | wc -c)" -eq 0 ] || error "The file should only contain letters, figures and underscores, and start with a lowercase letter" 24 | 25 | mkdir "$DESTDIR" 26 | cp "$PARSIFAL_DIR/Makefile.ocaml" "$DESTDIR/Makefile.ocaml" 27 | sed "s/project/$PROJECT_NAME/g" "$PARSIFAL_DIR/Makefile.template" > "$DESTDIR/Makefile" 28 | cat > "$DESTDIR/$PROJECT_NAME.ml" << EOF 29 | open Parsifal 30 | 31 | let _ = 32 | print_endline "Hello, world!" 33 | EOF 34 | -------------------------------------------------------------------------------- /net/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /net/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal Network library" 3 | requires = "unix str cryptokit camlp4 parsifal_syntax parsifal_core" 4 | archive(byte) = "parsifal_net.cma" 5 | archive(native) = "parsifal_net.cmxa" 6 | exists_if = "parsifal_net.cma" 7 | -------------------------------------------------------------------------------- /net/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | MLLIBS = parsifal_net 3 | LIBNAME = parsifal_net 4 | 5 | parsifal_net_SRCS := dns.ml pcap.ml mrt.ml pcapContainers.ml http.ml libntp.ml 6 | 7 | # comment this line if not using camlp4 8 | USE_CAMLP4 = yes 9 | 10 | CC = gcc 11 | 12 | # use the following lines to guess .cmxa files from libs names. 13 | # remember, libs are always lowercase 14 | OCAML_LIBS = unix str zarith cryptokit parsifal_syntax parsifal_core 15 | 16 | # use the following variables to add extra flags (not guessed by ocamlfind) 17 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 18 | EXTRA_OCAMLOPT_LD_FLAGS = 19 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 20 | EXTRA_OCAMLC_LD_FLAGS = 21 | 22 | BUILD_DIR = build 23 | 24 | 25 | include ../Makefile.ocaml 26 | -------------------------------------------------------------------------------- /net/test/.gitignore: -------------------------------------------------------------------------------- 1 | test_dns 2 | test_dns.byte 3 | test_mrt 4 | test_mrt.byte 5 | -------------------------------------------------------------------------------- /net/test/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_dns test_mrt 3 | 4 | test_dns_SRCS := test_dns.ml 5 | test_mrt_SRCS := test_mrt.ml 6 | 7 | # comment this line if not using camlp4 8 | USE_CAMLP4 = yes 9 | 10 | CC = gcc 11 | 12 | # use the following lines to guess .cmxa files from libs names. 13 | # remember, libs are always lowercase 14 | OCAML_LIBS = unix lwt lwt.unix str zarith result cryptokit \ 15 | parsifal_syntax parsifal_core parsifal_lwt parsifal_net 16 | 17 | # use the following variables to add extra flags (not guessed by ocamlfind) 18 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLOPT_LD_FLAGS = 20 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLC_LD_FLAGS = 22 | 23 | BUILD_DIR = build 24 | 25 | 26 | 27 | include ../../Makefile.ocaml 28 | 29 | 30 | check: all 31 | ./test_dns 32 | -------------------------------------------------------------------------------- /net/test/test_dns.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Dns 3 | 4 | 5 | let dns_query = "\x32\x65\x01\x00\x00\x01\x00\x00\x00\x00\x00\x00\x04\x79\x65\x79\x65\x02\x66\x72\x00\x00\x0f\x00\x01" 6 | 7 | let dns_answer = "\x32\x65\x81\x80\x00\x01\x00\x02\x00\x02\x00\x03\x04\x79\x65\x79\x65\x02\x66\x72\x00\x00\x0f\x00\x01\xc0\x0c\x00\x0f\x00\x01\x00\x00\x07\x08\x00\x10\x00\x0a\x0b\x70\x61\x70\x65\x72\x73\x74\x72\x65\x65\x74\xc0\x0c\xc0\x0c\x00\x0f\x00\x01\x00\x00\x07\x08\x00\x0d\x00\x0a\x08\x70\x69\x63\x74\x79\x62\x6f\x78\xc0\x0c\xc0\x0c\x00\x02\x00\x01\x00\x00\x07\x08\x00\x0b\x08\x67\x61\x72\x66\x69\x65\x6c\x64\xc0\x0c\xc0\x0c\x00\x02\x00\x01\x00\x00\x07\x08\x00\x02\xc0\x43\xc0\x43\x00\x01\x00\x01\x00\x00\x07\x08\x00\x04\xd5\xba\x39\x67\xc0\x27\x00\x01\x00\x01\x00\x00\x07\x08\x00\x04\x52\xe7\xeb\x89\xc0\x5a\x00\x01\x00\x01\x00\x00\x07\x08\x00\x04\x52\xe7\xeb\x89" 8 | 9 | let test_raw_message name content = 10 | print_endline (print_value (value_of_dns_message (parse_dns_message (input_of_string ~enrich:NeverEnrich name content)))) 11 | 12 | let test_message name content = 13 | print_endline (print_value (value_of_dns_message (parse_dns_message (input_of_string name content)))) 14 | 15 | let _ = 16 | try 17 | print_endline "RAW VERSION\n"; 18 | test_raw_message "dns_query" dns_query; 19 | test_raw_message "dns_answer" dns_answer; 20 | 21 | print_newline (); 22 | print_endline "SMART VERSION\n"; 23 | test_message "dns_query" dns_query; 24 | test_message "dns_answer" dns_answer; 25 | with 26 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 27 | | e -> prerr_endline (Printexc.to_string e); exit 1 28 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "parsifal" 3 | version: "0.1" 4 | maintainer: "Pierre Chambart " 5 | author: "Olivier Levillain (ANSSI)" 6 | homepage: "https://github.com/ANSSI-FR/parsifal/" 7 | bug-reports: "https://github.com/ANSSI-FR/parsifal/issues" 8 | license: "CECIL 2.0" 9 | build: [ 10 | make 11 | ] 12 | install: [ 13 | make "LIBDIR=%{lib}%" "BINDIR=%{bin}%" "install" 14 | ] 15 | remove: [ 16 | ["ocamlfind" "remove" "parsifal_core"] 17 | ["ocamlfind" "remove" "parsifal_crypto"] 18 | ["ocamlfind" "remove" "parsifal_formats"] 19 | ["ocamlfind" "remove" "parsifal_kerby"] 20 | ["ocamlfind" "remove" "parsifal_lwt"] 21 | ["ocamlfind" "remove" "parsifal_net"] 22 | ["ocamlfind" "remove" "parsifal_pgp"] 23 | ["ocamlfind" "remove" "parsifal_ssl"] 24 | ["ocamlfind" "remove" "parsifal_syntax"] 25 | ] 26 | depends: [ 27 | "ocamlfind" {build} 28 | "camlidl" 29 | "lwt" 30 | "cryptokit" 31 | "ounit" 32 | ] 33 | -------------------------------------------------------------------------------- /openpgp-tools/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | openpgp 3 | openpgp.byte 4 | -------------------------------------------------------------------------------- /openpgp/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /openpgp/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal OpenPGP library" 3 | requires = "unix str cryptokit camlp4 parsifal_syntax parsifal_core" 4 | archive(byte) = "parsifal_pgp.cma" 5 | archive(native) = "parsifal_pgp.cmxa" 6 | exists_if = "parsifal_pgp.cma" 7 | -------------------------------------------------------------------------------- /openpgp/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = 3 | MLLIBS = parsifal_pgp 4 | LIBNAME = parsifal_pgp 5 | 6 | parsifal_pgp_SRCS := libpgp.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix str zarith cryptokit parsifal_syntax parsifal_core parsifal_crypto 16 | 17 | # use the following variables to add extra flags (not guessed by ocamlfind) 18 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLOPT_LD_FLAGS = 20 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLC_LD_FLAGS = 22 | 23 | BUILD_DIR = build 24 | 25 | 26 | include ../Makefile.ocaml 27 | -------------------------------------------------------------------------------- /papers/Parsifal-paper--v0.1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/papers/Parsifal-paper--v0.1.pdf -------------------------------------------------------------------------------- /parsifal.install: -------------------------------------------------------------------------------- 1 | 2 | bin: [ 3 | "pci/test_pci" 4 | "tools/asn1parse" 5 | "tools/parsifal" 6 | "tools/picodig" 7 | "ssl-tools/probe_server" 8 | "ssl-tools/x509show" 9 | "ssl-tools/extractSessions" 10 | "ssl-tools/mapAnswers" 11 | "ssl-tools/sslrevproxy" 12 | "ssl-tools/serveranswer" 13 | "ssl-tools/sslproxy" 14 | "ssl-tools/disturber" 15 | ] 16 | -------------------------------------------------------------------------------- /pci/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | test_pci 3 | -------------------------------------------------------------------------------- /pci/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_pci 3 | 4 | test_pci_SRCS := pci.ml test_pci.ml 5 | 6 | # comment this line if not using camlp4 7 | USE_CAMLP4 = yes 8 | 9 | CC = gcc 10 | 11 | # use the following lines to guess .cmxa files from libs names. 12 | # remember, libs are always lowercase 13 | OCAML_LIBS = unix str zarith cryptokit parsifal_syntax parsifal_core parsifal_net parsifal_crypto 14 | 15 | # use the following variables to add extra flags (not guessed by ocamlfind) 16 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 17 | EXTRA_OCAMLOPT_LD_FLAGS = 18 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLC_LD_FLAGS = 20 | 21 | BUILD_DIR = build 22 | 23 | 24 | include ../Makefile.ocaml 25 | 26 | -------------------------------------------------------------------------------- /pci/test_pci.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Pci 3 | 4 | 5 | let _ = 6 | try 7 | let pci_filename = 8 | if Array.length Sys.argv > 1 9 | then Sys.argv.(1) 10 | else "test.pci" 11 | in 12 | let input = string_input_of_filename pci_filename in 13 | let pci_file = parse_rom_file input in 14 | print_endline (print_value (value_of_rom_file pci_file)); 15 | exit 0 16 | with 17 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 18 | | e -> prerr_endline (Printexc.to_string e); exit 1 19 | 20 | 21 | -------------------------------------------------------------------------------- /prepare-release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | 6 | # Script initialization 7 | 8 | PROGNAME=$0 9 | [ -n "$TMPDIR" ] || TMPDIR="/tmp" 10 | 11 | error () { 12 | echo "Error: $1" >&2 13 | echo "Usage: $0 [parsifal dir]" >&2 14 | exit 1 15 | } 16 | 17 | info () { 18 | [ -z "$VERBOSE" ] || echo "[INFO] $1" >&2 19 | } 20 | 21 | PARSIFAL_DIR=$1 22 | [ -z "$PARSIFAL_DIR" ] && PARSIFAL_DIR="$(dirname "$PROGNAME")" 23 | 24 | [ -d "$PARSIFAL_DIR/.git" ] || error "$PARSIFAL_DIR do not correspond to a git repo." 25 | 26 | if git log --format=oneline HEAD^..HEAD | grep WIP > /dev/null; then 27 | WIP_IN_COMMIT="YES" 28 | fi 29 | if [ -z "$DONT_MIND_WIP_IN_COMMIT" -a -n "$WIP_IN_COMMIT" ]; then 30 | echo "Beware of WIP in commit name!" 31 | echo "You can skip this warning by setting DONT_MIND_WIP_IN_COMMIT to something." 32 | exit 1 33 | fi 34 | 35 | 36 | # Temporary dir creation 37 | 38 | mkdir -p "$TMPDIR" 39 | TMPDIR=$(mktemp -d "$TMPDIR/parsifal_XXXXXX") 40 | info "Using temporary dir $TMPDIR" 41 | 42 | cd "$PARSIFAL_DIR" 43 | 44 | info "Creating parsifal archive" 45 | git archive --format tar -o "$TMPDIR/archive.tar" HEAD . 46 | 47 | info "Unfolding the archive" 48 | cd "$TMPDIR" 49 | mkdir build 50 | cd build 51 | if [ -n "$VERBOSE" ] 52 | then tar xvf "../archive.tar" 53 | else tar xf "../archive.tar" 54 | fi 55 | 56 | info "Building parsifal project" 57 | make 58 | 59 | info "Checking parsifal" 60 | make check 61 | 62 | info "Trying to install parsifal" 63 | BINDIR="$TMPDIR/bin" LIBDIR="$TMPDIR/lib" make install 64 | 65 | info "Checking whether the tutorial compiles" 66 | OCAMLPATH="$TMPDIR/lib" make -C tutorial/dns-steps byte 67 | OCAMLPATH="$TMPDIR/lib" make -C tutorial/tar-steps byte 68 | OCAMLPATH="$TMPDIR/lib" make -C tutorial/png-steps byte 69 | OCAMLPATH="$TMPDIR/lib" make -C tutorial/csr-steps byte 70 | 71 | info "Checking tls-decrypt feature" 72 | ( cd tools/test; ./tls-decrypt-test.sh ) 73 | echo "Seems OK to me..." 74 | 75 | 76 | # Cleaning up 77 | [ -n "$VERBOSE" ] || rm -rf "$TMPDIR" 78 | -------------------------------------------------------------------------------- /ssl-tools/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | mapAnswers 3 | mapAnswers.byte 4 | x509show 5 | x509show.byte 6 | check_sslclient 7 | check_sslclient.byte 8 | check_sslserver 9 | check_sslserver.byte 10 | probe_server 11 | probe_server.byte 12 | serveranswer 13 | serveranswer.byte 14 | sslproxy 15 | sslproxy.byte 16 | disturber 17 | disturber.byte 18 | extractSessions 19 | extractSessions.byte 20 | sslrevproxy 21 | sslrevproxy.byte 22 | -------------------------------------------------------------------------------- /ssl-tools/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = mapAnswers x509show probe_server serveranswer sslproxy disturber \ 3 | extractSessions sslrevproxy 4 | 5 | mapAnswers_SRCS := mapAnswers.ml 6 | x509show_SRCS := x509show.ml 7 | probe_server_SRCS := probe_server.ml 8 | serveranswer_SRCS := serveranswer.ml 9 | sslproxy_SRCS := sslproxy.ml 10 | disturber_SRCS := disturber.ml 11 | extractSessions_SRCS := extractSessions.ml 12 | sslrevproxy_SRCS := sslrevproxy.ml 13 | 14 | # comment this line if not using camlp4 15 | USE_CAMLP4 = yes 16 | 17 | CC = gcc 18 | 19 | # use the following lines to guess .cmxa files from libs names. 20 | # remember, libs are always lowercase 21 | OCAML_LIBS = unix result lwt lwt.unix str calendar zarith cryptokit \ 22 | parsifal_syntax parsifal_core parsifal_lwt parsifal_crypto parsifal_net parsifal_ssl 23 | 24 | # use the following variables to add extra flags (not guessed by ocamlfind) 25 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 26 | EXTRA_OCAMLOPT_LD_FLAGS = 27 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 28 | EXTRA_OCAMLC_LD_FLAGS = 29 | 30 | BUILD_DIR = build 31 | 32 | 33 | include ../Makefile.ocaml 34 | 35 | -------------------------------------------------------------------------------- /ssl-tools/check_sslclient.ml.TODO: -------------------------------------------------------------------------------- 1 | (* check_sslclient: TODO 2 | 3 | Versions 4 | ======== 5 | 6 | Check the version proposed? 7 | - Check the reaction when the version returned is outside the scope? 8 | - Version inconsistencies? 9 | - Check the alert returned (protocolVersion? IllegalParameter?) 10 | Check down negociation -> SSLv3 / SSLv2 11 | 12 | Suites 13 | ====== 14 | Does client accept ADH 15 | Check export suites 16 | Accept a suite that was never proposed (always RC4-MD5 for example, even if not proposed) 17 | 18 | Attacks 19 | ======= 20 | - Bleichenbacher 21 | - RFC5746 22 | - Beast 23 | - SSLStrip and HSTS support 24 | 25 | Record checks: same as check_sslserver 26 | 27 | Check the acceptable sizes of SID (0..32) 28 | Check the logic of session resumption (SID / SessionTicket) 29 | 30 | Check the suite/version/compression is consistant with the ClientHello sent 31 | 32 | [...] 33 | 34 | Check the minimum RSA size accepted by the client 35 | Check the minimum DH size accepted by the client 36 | Check the different versions to write 0 in DHE 37 | Check the client avoids DHE values in {-1;0;1} 38 | 39 | Check how subject naming is handled 40 | - multiple CN 41 | - wildcard 42 | - empty subject 43 | - IP in SAN/IPAddress 44 | - IP in SAN/URL 45 | - IP in SAN/DNSName 46 | - does SAN overrid CN?) 47 | 48 | Check wether revocation is checked (CRL / OCSP) 49 | 50 | Check wether the presence of \x00 works in CN/SAN/etc. 51 | 52 | Check whether a non-AC signed certificate is accepted 53 | 54 | Check whether the SKE signature is checked (aka the gotofail bug) 55 | 56 | Check whether an empty "extensions" field is a problem (specific case of extensions intolerance) 57 | Check how the client react to extensions when none were sent 58 | *) 59 | -------------------------------------------------------------------------------- /ssl-tools/sslproxy.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open LwtUtil 3 | open Unix 4 | 5 | open Parsifal 6 | open TlsEnums 7 | open Tls 8 | open Getopt 9 | 10 | 11 | let host = ref "www.google.com" 12 | let port = ref 443 13 | 14 | let options = [ 15 | mkopt (Some 'h') "help" Usage "show this help"; 16 | 17 | mkopt (Some 'H') "host" (StringVal host) "host to contact"; 18 | mkopt (Some 'p') "port" (IntVal port) "port to probe"; 19 | ] 20 | 21 | 22 | 23 | (* TODO: Handle exceptions in lwt code, and add timers *) 24 | 25 | 26 | type tls_state = { 27 | name : string; 28 | mutable clear : bool; 29 | } 30 | 31 | let empty_state name = 32 | { name = name; clear = true } 33 | 34 | 35 | 36 | let write_record o record = 37 | let s = exact_dump_tls_record record in 38 | really_write o s 39 | 40 | 41 | let rec forward state i o = 42 | let opts = incr_indent default_output_options in 43 | lwt_parse_wrapper (parse_tls_record None) i >>= fun record -> 44 | print_string (print_value ~name:state.name (value_of_tls_record record)); 45 | write_record o record >>= fun () -> 46 | try 47 | begin 48 | match record.content_type, state.clear with 49 | | CT_Handshake, true -> 50 | let hs_msg = parse_handshake_msg None (input_of_string "Handshake" (exact_dump_record_content record.record_content)) in 51 | print_endline (print_value ~options:opts ~name:"Handshake content" (value_of_handshake_msg hs_msg)) 52 | | CT_ChangeCipherSpec, true -> 53 | let hs_msg = parse_change_cipher_spec (input_of_string "CCS" (exact_dump_record_content record.record_content)) in 54 | print_endline (print_value ~options:opts ~name:"CCS content" (value_of_change_cipher_spec hs_msg)); 55 | state.clear <- false 56 | | CT_Alert, true -> 57 | let hs_msg = parse_tls_alert (input_of_string "Alert" (exact_dump_record_content record.record_content)) in 58 | print_endline (print_value ~options:opts ~name:"Alert content" (value_of_tls_alert hs_msg)) 59 | | _ -> print_newline () 60 | end; 61 | forward state i o 62 | with e -> fail e 63 | 64 | 65 | let catcher = function 66 | | ParsingException (e, h) -> 67 | Lwt_io.write_line Lwt_io.stderr (string_of_exception e h) 68 | | e -> 69 | Lwt_io.write_line Lwt_io.stderr (Printexc.to_string e) 70 | 71 | 72 | 73 | let rec accept sock = 74 | Lwt_unix.accept sock >>= fun (inp, remote_s) -> 75 | let p = match remote_s with 76 | | ADDR_INET (_, p) -> p 77 | | _ -> 0 78 | in 79 | LwtUtil.client_socket !host !port >>= fun out -> 80 | input_of_fd "Client socket" inp >>= fun i -> 81 | input_of_fd "Server socket" out >>= fun o -> 82 | let io = forward (empty_state (Printf.sprintf "%4.4x C->S" p)) i out in 83 | let oi = forward (empty_state (Printf.sprintf "%4.4x S->C" p)) o inp in 84 | catch (fun () -> pick [io; oi]) catcher >>= fun () -> 85 | ignore (Lwt_unix.close out); 86 | ignore (Lwt_unix.close inp); 87 | accept sock 88 | 89 | let _ = 90 | let _ = parse_args ~progname:"sslproxy" options Sys.argv in 91 | Lwt_main.run (LwtUtil.server_socket 8080 >>= accept) 92 | -------------------------------------------------------------------------------- /ssl/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /ssl/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal SSL library" 3 | requires = "unix lwt lwt.unix str cryptokit camlp4 parsifal_syntax parsifal_core parsifal_lwt" 4 | archive(byte) = "parsifal_ssl.cma" 5 | archive(native) = "parsifal_ssl.cmxa" 6 | exists_if = "parsifal_ssl.cma" 7 | -------------------------------------------------------------------------------- /ssl/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = 3 | MLLIBS = parsifal_ssl 4 | LIBNAME = parsifal_ssl 5 | 6 | parsifal_ssl_SRCS := answerDump.ml tlsEnums.ml tls.ml ssl2.ml tlsCrypto.ml tlsDatabase.ml tlsEngineNG.ml answerDumpUtil.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix result lwt lwt.unix str zarith cryptokit \ 16 | parsifal_syntax parsifal_core parsifal_lwt \ 17 | parsifal_crypto parsifal_net 18 | 19 | # use the following variables to add extra flags (not guessed by ocamlfind) 20 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLOPT_LD_FLAGS = 22 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 23 | EXTRA_OCAMLC_LD_FLAGS = 24 | 25 | BUILD_DIR = build 26 | 27 | 28 | include ../Makefile.ocaml 29 | -------------------------------------------------------------------------------- /ssl/answerDump.ml: -------------------------------------------------------------------------------- 1 | open BasePTypes 2 | 3 | 4 | struct answer_dump_v0 [top] = { 5 | o_ip : PTypes.ipv4; 6 | o_port : uint16; 7 | o_msg_type : uint8; 8 | o_content : binstring[uint32]; 9 | } 10 | 11 | 12 | struct answer_dump [top] = { 13 | ad_ip : PTypes.ipv4; 14 | ad_port : uint16; 15 | ad_name : string[uint16]; 16 | ad_client_hello_type : uint8; 17 | ad_msg_type : uint8; 18 | ad_content : binstring[uint32]; 19 | } 20 | 21 | 22 | type error = unit 23 | let parse_error err_msg _ = Parsifal.not_implemented err_msg 24 | let dump_error _ () = Parsifal.not_implemented "error" 25 | let value_of_error () = Parsifal.not_implemented "error" 26 | 27 | union ipv4_or_6 [enrich] (UnparsedIPType of error("UnparsedIPType")) = 28 | | 4 -> AD_IPv4 of PTypes.ipv4 29 | | 6 -> AD_IPv6 of PTypes.ipv6 30 | 31 | struct answer_dump_v2 [top] = { 32 | ip_type : uint8; 33 | ip_addr : ipv4_or_6(ip_type); 34 | port : uint16; 35 | name : string[uint16]; 36 | campaign : uint32; 37 | msg_type : uint8; (* This field has been kept for compatibility reasons *) 38 | timestamp : uint64; 39 | content : binstring[uint32] 40 | } 41 | 42 | 43 | 44 | let v2_of_v1 ?timestamp a = { 45 | ip_type = 4; 46 | ip_addr = AD_IPv4 a.ad_ip; 47 | port = a.ad_port; 48 | name = a.ad_name; 49 | campaign = a.ad_client_hello_type; 50 | timestamp = Parsifal.pop_opt Int64.zero timestamp; 51 | msg_type = a.ad_msg_type; 52 | content = a.ad_content; 53 | } 54 | 55 | let v1_of_v2 a = match a with 56 | | { ip_addr = AD_IPv4 ip } -> 57 | { 58 | ad_ip = ip; 59 | ad_port = a.port; 60 | ad_name = a.name; 61 | ad_client_hello_type = a.campaign; 62 | ad_msg_type = a.msg_type; 63 | ad_content = a.content; 64 | } 65 | | _ -> failwith "Unsupported IP type for v1 answer dump." 66 | 67 | 68 | let string_of_v2_ip = function 69 | | AD_IPv4 ipv4 -> PTypes.string_of_ipv4 ipv4 70 | | AD_IPv6 ipv6 -> PTypes.string_of_ipv6 ipv6 71 | | UnparsedIPType _ -> "Unsupported_IP_type" 72 | -------------------------------------------------------------------------------- /ssl/test/.gitignore: -------------------------------------------------------------------------------- 1 | test_random 2 | test_random.byte 3 | test_ssl2 4 | test_ssl2.byte 5 | test_tls_record 6 | test_tls_record.byte 7 | test_tls_server 8 | test_tls_server.byte 9 | test_tls_client 10 | test_tls_client.byte 11 | -------------------------------------------------------------------------------- /ssl/test/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_ssl2 test_tls_client test_tls_server 3 | 4 | test_ssl2_SRCS := test_ssl2.ml 5 | test_tls_client_SRCS := test_tls_client.ml 6 | test_tls_server_SRCS := test_tls_server.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix lwt lwt.unix str calendar zarith result cryptokit \ 16 | parsifal_syntax parsifal_core parsifal_lwt \ 17 | parsifal_crypto parsifal_net parsifal_ssl 18 | 19 | # use the following variables to add extra flags (not guessed by ocamlfind) 20 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLOPT_LD_FLAGS = 22 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 23 | EXTRA_OCAMLC_LD_FLAGS = 24 | 25 | BUILD_DIR = build 26 | 27 | 28 | 29 | include ../../Makefile.ocaml 30 | 31 | 32 | check: all 33 | -------------------------------------------------------------------------------- /ssl/test/test_tls_client.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open Parsifal 3 | open PTypes 4 | open TlsEnums 5 | open Tls 6 | open TlsEngineNG 7 | 8 | let test_client host port prefs = 9 | let ctx = { (empty_context prefs) with direction = Some ClientToServer } in 10 | resolve host port >>= (fun resolved_host -> init_client_connection resolved_host) >>= fun c_sock -> 11 | let ch () = mk_client_hello ctx in 12 | output_record ctx c_sock ch; 13 | run_automata client_automata ClientHelloSent "" ctx c_sock >>= fun _ -> 14 | let print_certs = function 15 | | Parsed (_, cert) -> 16 | print_endline (String.concat ", " (List.map X509Basics.string_of_atv (List.flatten cert.X509.tbsCertificate.X509.subject))) 17 | | _ -> () 18 | in 19 | List.iter print_certs ctx.future.f_certificates; 20 | Lwt_unix.close c_sock.socket 21 | 22 | let _ = 23 | if Array.length Sys.argv <> 3 24 | then begin 25 | prerr_endline "Usage: test_tls_client [host] [port]"; 26 | exit 1 27 | end; 28 | try 29 | TlsDatabase.enrich_suite_hash (); 30 | let host = Sys.argv.(1) 31 | and port = int_of_string Sys.argv.(2) in 32 | let prefs = { 33 | (default_prefs DummyRNG) with 34 | acceptable_ciphersuites = [TLS_RSA_WITH_RC4_128_MD5; TLS_RSA_WITH_AES_128_CBC_SHA] 35 | } in 36 | Unix.handle_unix_error Lwt_main.run (test_client host port prefs) 37 | with 38 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 39 | | e -> prerr_endline (Printexc.to_string e) 40 | -------------------------------------------------------------------------------- /ssl/test/test_tls_server.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Lwt 3 | open Tls 4 | open TlsEngineNG 5 | 6 | let test_server prefs = 7 | let ctx = empty_context prefs in 8 | init_server_connection 1234 >>= 9 | accept_client >>= fun c_sock -> 10 | run_automata server_automata ServerNil "" ctx c_sock >>= fun _ -> 11 | Lwt_unix.close c_sock.socket 12 | 13 | let _ = 14 | try 15 | TlsDatabase.enrich_suite_hash (); 16 | Unix.handle_unix_error Lwt_main.run (test_server (default_prefs DummyRNG)) 17 | with 18 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 19 | | e -> prerr_endline (Printexc.to_string e) 20 | -------------------------------------------------------------------------------- /ssl/unit/.gitignore: -------------------------------------------------------------------------------- 1 | oUnit-anon.cache 2 | test_prf 3 | test_prf.byte 4 | test_suites 5 | test_suites.byte 6 | -------------------------------------------------------------------------------- /ssl/unit/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = test_prf test_suites 3 | 4 | test_prf_SRCS := test_prf.ml 5 | test_suites_SRCS := test_suites.ml 6 | 7 | # comment this line if not using camlp4 8 | USE_CAMLP4 = yes 9 | 10 | CC = gcc 11 | 12 | # use the following lines to guess .cmxa files from libs names. 13 | # remember, libs are always lowercase 14 | OCAML_LIBS = unix lwt lwt.unix str calendar zarith result cryptokit \ 15 | parsifal_syntax parsifal_core parsifal_lwt \ 16 | parsifal_crypto parsifal_net parsifal_ssl oUnit 17 | 18 | # use the following variables to add extra flags (not guessed by ocamlfind) 19 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 20 | EXTRA_OCAMLOPT_LD_FLAGS = 21 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 22 | EXTRA_OCAMLC_LD_FLAGS = 23 | 24 | BUILD_DIR = build 25 | 26 | 27 | 28 | include ../../Makefile.ocaml 29 | 30 | 31 | check: test_prf test_suites 32 | ./test_prf 33 | ./test_suites 34 | -------------------------------------------------------------------------------- /syntax/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /syntax/META: -------------------------------------------------------------------------------- 1 | version = "0.1" 2 | description = "Parsifal syntax extensions" 3 | requires = "camlp4" 4 | archive(syntax,preprocessor) = "parsifal_syntax.cma" 5 | archive(syntax,toploop) = "parsifal_syntax.cma" 6 | exists_if = "parsifal_syntax.cma" 7 | -------------------------------------------------------------------------------- /syntax/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = 3 | MLLIBS = parsifal_syntax 4 | LIBNAME = parsifal_syntax 5 | 6 | parsifal_syntax_SRCS := parsifalHelpers.ml parsifalSyntax.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = 16 | 17 | # use the following variables to add extra flags (not guessed by ocamlfind) 18 | EXTRA_OCAMLOPT_CC_FLAGS = -package camlp4.extend -package camlp4.quotations.r 19 | EXTRA_OCAMLOPT_LD_FLAGS = 20 | EXTRA_OCAMLC_CC_FLAGS = -package camlp4.extend -package camlp4.quotations.r 21 | EXTRA_OCAMLC_LD_FLAGS = 22 | 23 | BUILD_DIR = build 24 | 25 | 26 | include ../Makefile.ocaml 27 | -------------------------------------------------------------------------------- /syntax/unit/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLFIND = ocamlfind 2 | CAMLP4 = camlp4o 3 | BUILD_DIR = build 4 | 5 | INCLUDES = $(shell $(OCAMLFIND) query -format "-I %d" -predicates syntax parsifal_syntax) 6 | 7 | .PRECIOUS: $(BUILD_DIR)/%.ast $(BUILD_DIR)/%.diff 8 | 9 | 10 | check: enum-01.test enum-02.test enum-03.test enum-04.test \ 11 | enum-05.test enum-06.test enum-07.test enum-08.test \ 12 | enum-09.test enum-0a.test enum-0b.test enum-0c.test \ 13 | enum-0d.test enum-0e.test enum-0f.test enum-10.test \ 14 | enum-11.test enum-12.test enum-13.test enum-14.test \ 15 | enum-15.test enum-16.test enum-17.test \ 16 | struct-01.test struct-02.test struct-03.test struct-04.test \ 17 | struct-05.test struct-06.test struct-07.test struct-08.test \ 18 | struct-09.test struct-0a.test struct-0b.test struct-0c.test \ 19 | struct-0d.test struct-0e.test struct-0f.test struct-10.test \ 20 | struct-11.test struct-12.test struct-13.test struct-14.test \ 21 | struct-15.test struct-16.test 22 | 23 | $(BUILD_DIR): 24 | @[ -d "$(BUILD_DIR)" ] || mkdir $(BUILD_DIR) 25 | 26 | $(BUILD_DIR)/%.ast: %.ml $(BUILD_DIR) 27 | @if $(CAMLP4) $(INCLUDES) -printer Camlp4OCamlPrinter parsifal_syntax.cma -o $@ $< 2> $(BUILD_DIR)/$*.err; \ 28 | then rm -f $(BUILD_DIR)/$*.err; \ 29 | else mv $(BUILD_DIR)/$*.err $(BUILD_DIR)/$*.ast; \ 30 | fi 31 | 32 | $(BUILD_DIR)/%.diff: $(BUILD_DIR)/%.ast %.out 33 | @diff $< $*.out > $@ 34 | 35 | %.test: $(BUILD_DIR)/%.diff 36 | @echo $* OK 37 | 38 | 39 | clean: 40 | [ -z "$(BUILD_DIR)" ] || rm -rf $(BUILD_DIR) 41 | -------------------------------------------------------------------------------- /syntax/unit/enum-01.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-01.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-02.ml: -------------------------------------------------------------------------------- 1 | enum test (8, UnknownVal U) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-02.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D | U of int 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 | U i -> i 4 | 5 | let string_of_test = 6 | function 7 | | A -> "A" 8 | | B -> "B" 9 | | C -> "C" 10 | | D -> "D" 11 | | U i -> "Unknown test (" ^ ((string_of_int i) ^ ")") 12 | 13 | let test_of_int = function | 0 -> A | 1 -> B | 2 -> C | 3 -> D | i -> U i 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-03.ml: -------------------------------------------------------------------------------- 1 | enum test (16, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-03.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint16 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint16 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-04.ml: -------------------------------------------------------------------------------- 1 | enum test (24, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-04.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint24 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint24 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-05.ml: -------------------------------------------------------------------------------- 1 | enum test (32, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-05.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint32 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint32 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-06.ml: -------------------------------------------------------------------------------- 1 | enum test (1, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | -------------------------------------------------------------------------------- /syntax/unit/enum-06.out: -------------------------------------------------------------------------------- 1 | type test = | A | B 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | i -> Parsifal.value_not_in_enum "test" i history 12 | 13 | let test_of_string = 14 | function | "A" -> A | "B" -> B | s -> test_of_int (int_of_string s) 15 | 16 | let parse_test input = test_of_int (Parsifal.parse_bits 1 input) 17 | 18 | let dump_test buf test = POutput.add_bits buf 1 (int_of_test test) 19 | 20 | let value_of_test test = 21 | Parsifal.value_of_enum string_of_test int_of_test test 22 | 23 | 24 | -------------------------------------------------------------------------------- /syntax/unit/enum-07.ml: -------------------------------------------------------------------------------- 1 | enum test (2, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-07.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (Parsifal.parse_bits 2 input) 24 | 25 | let dump_test buf test = POutput.add_bits buf 2 (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-08.ml: -------------------------------------------------------------------------------- 1 | enum test (3, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-08.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (Parsifal.parse_bits 3 input) 24 | 25 | let dump_test buf test = POutput.add_bits buf 3 (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-09.ml: -------------------------------------------------------------------------------- 1 | enum test (4, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-09.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (Parsifal.parse_bits 4 input) 24 | 25 | let dump_test buf test = POutput.add_bits buf 4 (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-0a.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A 3 | -------------------------------------------------------------------------------- /syntax/unit/enum-0a.out: -------------------------------------------------------------------------------- 1 | type test = | A 2 | 3 | let int_of_test = function | A -> 0 4 | 5 | let string_of_test = function | A -> "A" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function | 0 -> A | i -> Parsifal.value_not_in_enum "test" i history 9 | 10 | let test_of_string = function | "A" -> A | s -> test_of_int (int_of_string s) 11 | 12 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 13 | 14 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 15 | 16 | let value_of_test test = 17 | Parsifal.value_of_enum string_of_test int_of_test test 18 | 19 | 20 | -------------------------------------------------------------------------------- /syntax/unit/enum-0c.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> A 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-0c.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> A 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | s -> test_of_int (int_of_string s) 21 | 22 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 23 | 24 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 25 | 26 | let value_of_test test = 27 | Parsifal.value_of_enum string_of_test int_of_test test 28 | 29 | 30 | -------------------------------------------------------------------------------- /syntax/unit/enum-0d.ml: -------------------------------------------------------------------------------- 1 | enum test [little_endian] (8, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-0d.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint8le input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint8le buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-0e.ml: -------------------------------------------------------------------------------- 1 | enum test [little_endian] (16, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-0e.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint16le input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint16le buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-0f.ml: -------------------------------------------------------------------------------- 1 | enum test [little_endian] (24, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-0f.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint24le input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint24le buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-10.ml: -------------------------------------------------------------------------------- 1 | enum test [little_endian] (32, Exception) = 2 | | 0 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-10.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> B 11 | | 2 -> C 12 | | 3 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint32le input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint32le buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-11.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A, "First constructor A" 3 | | 1 -> B, "BBB" 4 | | 2 -> C 5 | | 3 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-11.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 | D -> 3 4 | 5 | let string_of_test = 6 | function | A -> "First constructor A" | B -> "BBB" | C -> "C" | D -> "D" 7 | 8 | let test_of_int ?history:(history = []) = 9 | function 10 | | 0 -> A 11 | | 1 -> B 12 | | 2 -> C 13 | | 3 -> D 14 | | i -> Parsifal.value_not_in_enum "test" i history 15 | 16 | let test_of_string = 17 | function 18 | | "First constructor A" -> A 19 | | "BBB" -> B 20 | | "C" -> C 21 | | "D" -> D 22 | | s -> test_of_int (int_of_string s) 23 | 24 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 25 | 26 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 27 | 28 | let value_of_test test = 29 | Parsifal.value_of_enum string_of_test int_of_test test 30 | 31 | 32 | -------------------------------------------------------------------------------- /syntax/unit/enum-12.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A 3 | | 0x1 -> B 4 | | 0o2 -> C 5 | | 0b11 -> D 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-12.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C | D 2 | 3 | let int_of_test = function | A -> 0 | B -> 0x1 | C -> 0o2 | D -> 0b11 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" | D -> "D" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 0x1 -> B 11 | | 0o2 -> C 12 | | 0b11 -> D 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | "D" -> D 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-13.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A, "First constructor A" 3 | | 1 -> B, "BBB" 4 | | 2 -> C 5 | | 3 -> A, "First constructor A" 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-13.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 4 | 5 | let string_of_test = 6 | function | A -> "First constructor A" | B -> "BBB" | C -> "C" 7 | 8 | let test_of_int ?history:(history = []) = 9 | function 10 | | 0 -> A 11 | | 1 -> B 12 | | 2 -> C 13 | | 3 -> A 14 | | i -> Parsifal.value_not_in_enum "test" i history 15 | 16 | let test_of_string = 17 | function 18 | | "First constructor A" -> A 19 | | "BBB" -> B 20 | | "C" -> C 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-14.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 -> A, "First constructor A" 3 | | 1 -> B, "BBB" 4 | | 2 -> C 5 | | 3 -> A 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-14.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 4 | 5 | let string_of_test = 6 | function | A -> "First constructor A" | B -> "BBB" | C -> "C" 7 | 8 | let test_of_int ?history:(history = []) = 9 | function 10 | | 0 -> A 11 | | 1 -> B 12 | | 2 -> C 13 | | 3 -> A 14 | | i -> Parsifal.value_not_in_enum "test" i history 15 | 16 | let test_of_string = 17 | function 18 | | "First constructor A" -> A 19 | | "BBB" -> B 20 | | "C" -> C 21 | | s -> test_of_int (int_of_string s) 22 | 23 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 24 | 25 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 26 | 27 | let value_of_test test = 28 | Parsifal.value_of_enum string_of_test int_of_test test 29 | 30 | 31 | -------------------------------------------------------------------------------- /syntax/unit/enum-15.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0 | 3 -> A 3 | | 1 -> B 4 | | 2 -> C 5 | 6 | -------------------------------------------------------------------------------- /syntax/unit/enum-15.out: -------------------------------------------------------------------------------- 1 | type test = | A | B | C 2 | 3 | let int_of_test = function | A -> 0 | B -> 1 | C -> 2 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" | C -> "C" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 3 -> A 11 | | 1 -> B 12 | | 2 -> C 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function 17 | | "A" -> A 18 | | "B" -> B 19 | | "C" -> C 20 | | s -> test_of_int (int_of_string s) 21 | 22 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 23 | 24 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 25 | 26 | let value_of_test test = 27 | Parsifal.value_of_enum string_of_test int_of_test test 28 | 29 | 30 | -------------------------------------------------------------------------------- /syntax/unit/enum-16.ml: -------------------------------------------------------------------------------- 1 | enum test (8, Exception) = 2 | | 0, 2 -> A 3 | | 3 -> B 4 | -------------------------------------------------------------------------------- /syntax/unit/enum-16.out: -------------------------------------------------------------------------------- 1 | type test = | A | B 2 | 3 | let int_of_test = function | A -> 0 | B -> 3 4 | 5 | let string_of_test = function | A -> "A" | B -> "B" 6 | 7 | let test_of_int ?history:(history = []) = 8 | function 9 | | 0 -> A 10 | | 1 -> A 11 | | 2 -> A 12 | | 3 -> B 13 | | i -> Parsifal.value_not_in_enum "test" i history 14 | 15 | let test_of_string = 16 | function | "A" -> A | "B" -> B | s -> test_of_int (int_of_string s) 17 | 18 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 19 | 20 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 21 | 22 | let value_of_test test = 23 | Parsifal.value_of_enum string_of_test int_of_test test 24 | 25 | 26 | -------------------------------------------------------------------------------- /syntax/unit/enum-17.ml: -------------------------------------------------------------------------------- 1 | enum test (8, UnknownVal Unknown) = 2 | | 0 -> Zero, "0" 3 | | 1 -> One 4 | | 2 | 3 -> TwoOrThree, "2 or 3" 5 | | 4 | 5 -> FourOrFive 6 | | 6, 10 -> SixToTen, "6 .. 10" 7 | | 11, 20 -> More 8 | -------------------------------------------------------------------------------- /syntax/unit/enum-17.out: -------------------------------------------------------------------------------- 1 | type test = 2 | | Zero | One | TwoOrThree | FourOrFive | SixToTen | More | Unknown of int 3 | 4 | let int_of_test = 5 | function 6 | | Zero -> 0 7 | | One -> 1 8 | | TwoOrThree -> 2 9 | | FourOrFive -> 4 10 | | SixToTen -> 6 11 | | More -> 11 12 | | Unknown i -> i 13 | 14 | let string_of_test = 15 | function 16 | | Zero -> "0" 17 | | One -> "One" 18 | | TwoOrThree -> "2 or 3" 19 | | FourOrFive -> "FourOrFive" 20 | | SixToTen -> "6 .. 10" 21 | | More -> "More" 22 | | Unknown i -> "Unknown test (" ^ ((string_of_int i) ^ ")") 23 | 24 | let test_of_int = 25 | function 26 | | 0 -> Zero 27 | | 1 -> One 28 | | 2 -> TwoOrThree 29 | | 3 -> TwoOrThree 30 | | 4 -> FourOrFive 31 | | 5 -> FourOrFive 32 | | 6 -> SixToTen 33 | | 7 -> SixToTen 34 | | 8 -> SixToTen 35 | | 9 -> SixToTen 36 | | 10 -> SixToTen 37 | | 11 -> More 38 | | 12 -> More 39 | | 13 -> More 40 | | 14 -> More 41 | | 15 -> More 42 | | 16 -> More 43 | | 17 -> More 44 | | 18 -> More 45 | | 19 -> More 46 | | 20 -> More 47 | | i -> Unknown i 48 | 49 | let test_of_string = 50 | function 51 | | "0" -> Zero 52 | | "One" -> One 53 | | "2 or 3" -> TwoOrThree 54 | | "FourOrFive" -> FourOrFive 55 | | "6 .. 10" -> SixToTen 56 | | "More" -> More 57 | | s -> test_of_int (int_of_string s) 58 | 59 | let parse_test input = test_of_int (BasePTypes.parse_uint8 input) 60 | 61 | let dump_test buf test = BasePTypes.dump_uint8 buf (int_of_test test) 62 | 63 | let value_of_test test = 64 | Parsifal.value_of_enum string_of_test int_of_test test 65 | 66 | 67 | -------------------------------------------------------------------------------- /syntax/unit/enum.list: -------------------------------------------------------------------------------- 1 | # Enum unit tests 2 | enum-01 # 8 bits, 4 choices, Exception 3 | enum-02 # 8 bits, 4 choices, UnknownVal 4 | enum-03 # 16 bits, 4 choices, Exception 5 | enum-04 # 24 bits, 4 choices, Exception 6 | enum-05 # 32 bits, 4 choices, Exception 7 | enum-06 # 1 bit, 2 choices, Exception 8 | enum-07 # 2 bits, 4 choices, Exception 9 | enum-08 # 3 bits, 4 choices, Exception 10 | enum-09 # 4 bits, 4 choices, Exception 11 | enum-0a # 8 bits, 1 choice, Exception 12 | enum-0b # 8 bits, 200 choices, Exception 13 | enum-0c # 8 bits, colliding choices 14 | enum-0d # 8 bits, 4 choices, Exception, little-endian 15 | enum-0e # 16 bits, 4 choices, Exception, little-endian 16 | enum-0f # 24 bits, 4 choices, Exception, little-endian 17 | enum-10 # 32 bits, 4 choices, Exception, little-endian 18 | enum-11 # 8 bits, 4 choices, pretty-print strings 19 | enum-12 # 8-bits, different numeric representations 20 | enum-13 # 8 bits, 4 choices, pretty-print strings with colliding constructors 21 | enum-14 # 8 bits, 4 choices, pretty-print strings with inconsistant colliding constructors => should issue a warning? 22 | enum-15 # alternative syntax 23 | enum-16 # range syntax 24 | enum-17 # enum_test.ml 25 | 26 | #enum-XX # repetition of a discriminating value => should issue a warning at preprocessor time if possible (there ill be a warning at compile time) ? 27 | #enum-XX # alternative (| X | Y ->) syntax with a repetition => should issue a warning 28 | #enum-XX # range (| X, Y ->) syntax with a repetition or with Y < X 29 | #enum-XX # error messages should be tested 30 | 31 | #enum-XX # 1 bit, 2 choices, Exception, little-endian => should issue not_implemented 32 | #enum-XX # 2 bits, 4 choices, Exception, little-endian => should issue not_implemented 33 | -------------------------------------------------------------------------------- /syntax/unit/enum_test.ml: -------------------------------------------------------------------------------- 1 | enum pouet (8, UnknownVal Unknown) = 2 | | 0 -> Zero, "0" 3 | | 1 -> One 4 | | 2 | 3 -> TwoOrThree, "2 or 3" 5 | | 4 | 5 -> FourOrFive 6 | | 6, 10 -> SixToTen, "6 .. 10" 7 | | 11, 20 -> More 8 | -------------------------------------------------------------------------------- /syntax/unit/struct-01.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | } 4 | -------------------------------------------------------------------------------- /syntax/unit/struct-01.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8 } 2 | 3 | let parse_s input = let x = parse_uint8 input in { x = x; } 4 | 5 | let dump_s buf s = let _x = dump_uint8 buf s.x in () 6 | 7 | let value_of_s s = 8 | Parsifal.VRecord 9 | [ ("@name", (Parsifal.VString (("s", false)))); 10 | ("x", (value_of_uint8 s.x)) ] 11 | 12 | 13 | -------------------------------------------------------------------------------- /syntax/unit/struct-02.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | y : uint16; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-02.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : uint16 } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let y = parse_uint16 input in { x = x; y = y; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in let _y = dump_uint16 buf s.y in () 9 | 10 | let value_of_s s = 11 | Parsifal.VRecord 12 | [ ("@name", (Parsifal.VString (("s", false)))); 13 | ("x", (value_of_uint8 s.x)); ("y", (value_of_uint16 s.y)) ] 14 | 15 | 16 | -------------------------------------------------------------------------------- /syntax/unit/struct-03.ml: -------------------------------------------------------------------------------- 1 | struct s [top] = { 2 | x : uint8; 3 | y : uint16; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-03.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : uint16 } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let y = parse_uint16 input in { x = x; y = y; } 6 | 7 | let exact_parse_s input = Parsifal.exact_parse parse_s input 8 | 9 | let dump_s buf s = 10 | let _x = dump_uint8 buf s.x in let _y = dump_uint16 buf s.y in () 11 | 12 | let exact_dump_s s = Parsifal.exact_dump dump_s s 13 | 14 | let value_of_s s = 15 | Parsifal.VRecord 16 | [ ("@name", (Parsifal.VString (("s", false)))); 17 | ("x", (value_of_uint8 s.x)); ("y", (value_of_uint16 s.y)) ] 18 | 19 | 20 | -------------------------------------------------------------------------------- /syntax/unit/struct-04.ml: -------------------------------------------------------------------------------- 1 | struct s [param n] = { 2 | x : uint8; 3 | l : list(n) of uint16; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-04.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; l : uint16 list } 2 | 3 | let parse_s n input = 4 | let x = parse_uint8 input in 5 | let l = parse_list n "l" parse_uint16 input in { x = x; l = l; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in let _l = dump_list dump_uint16 buf s.l in () 9 | 10 | let value_of_s s = 11 | Parsifal.VRecord 12 | [ ("@name", (Parsifal.VString (("s", false)))); 13 | ("x", (value_of_uint8 s.x)); ("l", (value_of_list value_of_uint16 s.l)) ] 14 | 15 | 16 | -------------------------------------------------------------------------------- /syntax/unit/struct-05.ml: -------------------------------------------------------------------------------- 1 | struct s [param n; param m] = { 2 | x : uint8; 3 | l : list(n) of uint16; 4 | sl : list(m) of string(4); 5 | } 6 | -------------------------------------------------------------------------------- /syntax/unit/struct-05.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; l : uint16 list; sl : BasePTypes.string list } 2 | 3 | let parse_s n m input = 4 | let x = parse_uint8 input in 5 | let l = parse_list n "l" parse_uint16 input in 6 | let sl = parse_list m "sl" (BasePTypes.parse_string 4) input 7 | in { x = x; l = l; sl = sl; } 8 | 9 | let dump_s buf s = 10 | let _x = dump_uint8 buf s.x in 11 | let _l = dump_list dump_uint16 buf s.l in 12 | let _sl = dump_list BasePTypes.dump_string buf s.sl in () 13 | 14 | let value_of_s s = 15 | Parsifal.VRecord 16 | [ ("@name", (Parsifal.VString (("s", false)))); 17 | ("x", (value_of_uint8 s.x)); 18 | ("l", (value_of_list value_of_uint16 s.l)); 19 | ("sl", (value_of_list BasePTypes.value_of_string s.sl)) ] 20 | 21 | 22 | -------------------------------------------------------------------------------- /syntax/unit/struct-06.ml: -------------------------------------------------------------------------------- 1 | struct s [param n; param n] = { 2 | x : uint8; 3 | l : list(n) of uint16; 4 | sl : list(n) of string(4); 5 | } 6 | -------------------------------------------------------------------------------- /syntax/unit/struct-06.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; l : uint16 list; sl : BasePTypes.string list } 2 | 3 | let parse_s n n input = 4 | let x = parse_uint8 input in 5 | let l = parse_list n "l" parse_uint16 input in 6 | let sl = parse_list n "sl" (BasePTypes.parse_string 4) input 7 | in { x = x; l = l; sl = sl; } 8 | 9 | let dump_s buf s = 10 | let _x = dump_uint8 buf s.x in 11 | let _l = dump_list dump_uint16 buf s.l in 12 | let _sl = dump_list BasePTypes.dump_string buf s.sl in () 13 | 14 | let value_of_s s = 15 | Parsifal.VRecord 16 | [ ("@name", (Parsifal.VString (("s", false)))); 17 | ("x", (value_of_uint8 s.x)); 18 | ("l", (value_of_list value_of_uint16 s.l)); 19 | ("sl", (value_of_list BasePTypes.value_of_string s.sl)) ] 20 | 21 | 22 | -------------------------------------------------------------------------------- /syntax/unit/struct-07.ml: -------------------------------------------------------------------------------- 1 | struct s [param n] = { 2 | x : uint8; 3 | y : uint16; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-07.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : uint16 } 2 | 3 | let parse_s n input = 4 | let x = parse_uint8 input in 5 | let y = parse_uint16 input in { x = x; y = y; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in let _y = dump_uint16 buf s.y in () 9 | 10 | let value_of_s s = 11 | Parsifal.VRecord 12 | [ ("@name", (Parsifal.VString (("s", false)))); 13 | ("x", (value_of_uint8 s.x)); ("y", (value_of_uint16 s.y)) ] 14 | 15 | 16 | -------------------------------------------------------------------------------- /syntax/unit/struct-08.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | x : string; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-08.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; x : BasePTypes.rem_string } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let x = BasePTypes.parse_rem_string input in { x = x; x = x; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in 9 | let _x = BasePTypes.dump_rem_string buf s.x in () 10 | 11 | let value_of_s s = 12 | Parsifal.VRecord 13 | [ ("@name", (Parsifal.VString (("s", false)))); 14 | ("x", (value_of_uint8 s.x)); 15 | ("x", (BasePTypes.value_of_rem_string s.x)) ] 16 | 17 | 18 | -------------------------------------------------------------------------------- /syntax/unit/struct-09.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | s : string; 3 | x : uint8; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-09.out: -------------------------------------------------------------------------------- 1 | type s = { s : BasePTypes.rem_string; x : uint8 } 2 | 3 | let parse_s input = 4 | let s = BasePTypes.parse_rem_string input in 5 | let x = parse_uint8 input in { s = s; x = x; } 6 | 7 | let dump_s buf s = 8 | let _s = BasePTypes.dump_rem_string buf s.s in 9 | let _x = dump_uint8 buf s.x in () 10 | 11 | let value_of_s s = 12 | Parsifal.VRecord 13 | [ ("@name", (Parsifal.VString (("s", false)))); 14 | ("s", (BasePTypes.value_of_rem_string s.s)); 15 | ("x", (value_of_uint8 s.x)) ] 16 | 17 | 18 | -------------------------------------------------------------------------------- /syntax/unit/struct-0a.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | optional y : uint16; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-0a.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : uint16 option } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let y = Parsifal.try_parse parse_uint16 input in { x = x; y = y; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in 9 | let _y = Parsifal.try_dump dump_uint16 buf s.y in () 10 | 11 | let value_of_s s = 12 | Parsifal.VRecord 13 | [ ("@name", (Parsifal.VString (("s", false)))); 14 | ("x", (value_of_uint8 s.x)); 15 | ("y", (Parsifal.try_value_of value_of_uint16 s.y)) ] 16 | 17 | 18 | -------------------------------------------------------------------------------- /syntax/unit/struct-0b.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | parse_checkpoint y : save_offset; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-0b.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8 } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in let y = parse_save_offset input in { x = x; } 5 | 6 | let dump_s buf s = let _x = dump_uint8 buf s.x in () 7 | 8 | let value_of_s s = 9 | Parsifal.VRecord 10 | [ ("@name", (Parsifal.VString (("s", false)))); 11 | ("x", (value_of_uint8 s.x)) ] 12 | 13 | 14 | -------------------------------------------------------------------------------- /syntax/unit/struct-0c.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | parse_checkpoint : save_offset; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-0c.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8 } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let _evanescent_var_0001 = parse_save_offset input in { x = x; } 6 | 7 | let dump_s buf s = let _x = dump_uint8 buf s.x in () 8 | 9 | let value_of_s s = 10 | Parsifal.VRecord 11 | [ ("@name", (Parsifal.VString (("s", false)))); 12 | ("x", (value_of_uint8 s.x)) ] 13 | 14 | 15 | -------------------------------------------------------------------------------- /syntax/unit/struct-0d.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | parse_field y : copy(x+1); 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-0d.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : copy } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let y = parse_copy (x + 1) input in { x = x; y = y; } 6 | 7 | let dump_s buf s = let _x = dump_uint8 buf s.x in () 8 | 9 | let value_of_s s = 10 | Parsifal.VRecord 11 | [ ("@name", (Parsifal.VString (("s", false)))); 12 | ("x", (value_of_uint8 s.x)); ("@y", (value_of_copy s.y)) ] 13 | 14 | 15 | -------------------------------------------------------------------------------- /syntax/unit/struct-0e.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | dump_checkpoint y : debug_dump; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-0e.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8 } 2 | 3 | let parse_s input = let x = parse_uint8 input in { x = x; } 4 | 5 | let dump_s buf s = 6 | let _x = dump_uint8 buf s.x in let y = dump_debug_dump buf in () 7 | 8 | let value_of_s s = 9 | Parsifal.VRecord 10 | [ ("@name", (Parsifal.VString (("s", false)))); 11 | ("x", (value_of_uint8 s.x)) ] 12 | 13 | 14 | -------------------------------------------------------------------------------- /syntax/unit/struct-0f.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | dump_checkpoint : debug_dump; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-0f.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8 } 2 | 3 | let parse_s input = let x = parse_uint8 input in { x = x; } 4 | 5 | let dump_s buf s = 6 | let _x = dump_uint8 buf s.x in 7 | let _evanescent_var_0001 = dump_debug_dump buf in () 8 | 9 | let value_of_s s = 10 | Parsifal.VRecord 11 | [ ("@name", (Parsifal.VString (("s", false)))); 12 | ("x", (value_of_uint8 s.x)) ] 13 | 14 | 15 | -------------------------------------------------------------------------------- /syntax/unit/struct-10.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : uint8; 3 | dump_arg x; 4 | y : nt_string[x]; 5 | } 6 | -------------------------------------------------------------------------------- /syntax/unit/struct-10.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : nt_string } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let y = parse_nt_string x input in { x = x; y = y; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in 9 | let x = s.x in let _y = dump_nt_string x buf s.y in () 10 | 11 | let value_of_s s = 12 | Parsifal.VRecord 13 | [ ("@name", (Parsifal.VString (("s", false)))); 14 | ("x", (value_of_uint8 s.x)); ("y", (value_of_nt_string s.y)) ] 15 | 16 | 17 | -------------------------------------------------------------------------------- /syntax/unit/struct-11.ml: -------------------------------------------------------------------------------- 1 | struct s [parse_param n] = { 2 | x : uint8; 3 | l : list(PARSE n) of uint16; 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-11.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; l : uint16 list } 2 | 3 | let parse_s n input = 4 | let x = parse_uint8 input in 5 | let l = parse_list n "l" parse_uint16 input in { x = x; l = l; } 6 | 7 | let dump_s buf s = 8 | let _x = dump_uint8 buf s.x in let _l = dump_list dump_uint16 buf s.l in () 9 | 10 | let value_of_s s = 11 | Parsifal.VRecord 12 | [ ("@name", (Parsifal.VString (("s", false)))); 13 | ("x", (value_of_uint8 s.x)); ("l", (value_of_list value_of_uint16 s.l)) ] 14 | 15 | 16 | -------------------------------------------------------------------------------- /syntax/unit/struct-12.ml: -------------------------------------------------------------------------------- 1 | struct s [dump_param n] = { 2 | x : uint8; 3 | y : custom(DUMP n); 4 | } 5 | -------------------------------------------------------------------------------- /syntax/unit/struct-12.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8; y : custom } 2 | 3 | let parse_s input = 4 | let x = parse_uint8 input in 5 | let y = parse_custom input in { x = x; y = y; } 6 | 7 | let dump_s n buf s = 8 | let _x = dump_uint8 buf s.x in let _y = dump_custom n buf s.y in () 9 | 10 | let value_of_s s = 11 | Parsifal.VRecord 12 | [ ("@name", (Parsifal.VString (("s", false)))); 13 | ("x", (value_of_uint8 s.x)); ("y", (value_of_custom s.y)) ] 14 | 15 | 16 | -------------------------------------------------------------------------------- /syntax/unit/struct-13.ml: -------------------------------------------------------------------------------- 1 | struct s [both_param n] = { 2 | x : custom(BOTH n); 3 | } 4 | -------------------------------------------------------------------------------- /syntax/unit/struct-13.out: -------------------------------------------------------------------------------- 1 | type s = { x : custom } 2 | 3 | let parse_s n input = let x = parse_custom n input in { x = x; } 4 | 5 | let dump_s n buf s = let _x = dump_custom n buf s.x in () 6 | 7 | let value_of_s s = 8 | Parsifal.VRecord 9 | [ ("@name", (Parsifal.VString (("s", false)))); 10 | ("x", (value_of_custom s.x)) ] 11 | 12 | 13 | -------------------------------------------------------------------------------- /syntax/unit/struct-14.ml: -------------------------------------------------------------------------------- 1 | struct s [both_param n] = { 2 | x : custom[n] of uint8; 3 | } 4 | -------------------------------------------------------------------------------- /syntax/unit/struct-14.out: -------------------------------------------------------------------------------- 1 | type s = { x : uint8 custom } 2 | 3 | let parse_s n input = 4 | let x = parse_custom n "x" parse_uint8 input in { x = x; } 5 | 6 | let dump_s n buf s = let _x = dump_custom n dump_uint8 buf s.x in () 7 | 8 | let value_of_s s = 9 | Parsifal.VRecord 10 | [ ("@name", (Parsifal.VString (("s", false)))); 11 | ("x", (value_of_custom value_of_uint8 s.x)) ] 12 | 13 | 14 | -------------------------------------------------------------------------------- /syntax/unit/struct-15.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : custom [BOTH a; b]; 3 | } 4 | -------------------------------------------------------------------------------- /syntax/unit/struct-15.out: -------------------------------------------------------------------------------- 1 | type s = { x : custom } 2 | 3 | let parse_s input = let x = parse_custom a b input in { x = x; } 4 | 5 | let dump_s buf s = let _x = dump_custom a b buf s.x in () 6 | 7 | let value_of_s s = 8 | Parsifal.VRecord 9 | [ ("@name", (Parsifal.VString (("s", false)))); 10 | ("x", (value_of_custom s.x)) ] 11 | 12 | 13 | -------------------------------------------------------------------------------- /syntax/unit/struct-16.ml: -------------------------------------------------------------------------------- 1 | struct s = { 2 | x : custom [CONTEXT uint48]; 3 | } 4 | -------------------------------------------------------------------------------- /syntax/unit/struct-16.out: -------------------------------------------------------------------------------- 1 | type s = { x : custom } 2 | 3 | let parse_s input = let x = parse_custom parse_uint48 input in { x = x; } 4 | 5 | let dump_s buf s = let _x = dump_custom dump_uint48 buf s.x in () 6 | 7 | let value_of_s s = 8 | Parsifal.VRecord 9 | [ ("@name", (Parsifal.VString (("s", false)))); 10 | ("x", (value_of_custom s.x)) ] 11 | 12 | 13 | -------------------------------------------------------------------------------- /syntax/unit/struct.list: -------------------------------------------------------------------------------- 1 | # Struct unit tests 2 | struct-01 # 1 field 3 | struct-02 # 2 fields 4 | struct-03 # top option 5 | struct-04 # 1 parameter 6 | struct-05 # 2 parameters 7 | struct-06 # 2 parameters (same name) => TODO: should issue a warning? 8 | struct-07 # 1 unused parameter => TODO: should issue a warning? 9 | struct-08 # 2 fields with colliding names => TODO: should issue a warning? 10 | struct-09 # field name colliding with the struct name => warning? or only with dump_arg? 11 | struct-0a # optional field 12 | struct-0b # parse_checkpoint 13 | struct-0c # unnamed parse_checkpoint 14 | struct-0d # parse_field 15 | struct-0e # dump_checkpoint 16 | struct-0f # unnamed dump_checkpoint 17 | struct-10 # dump_arg 18 | struct-11 # parse_param / PARSE 19 | struct-12 # dump_param 20 | struct-13 # both_param 21 | struct-14 # both_param ([] syntax) 22 | struct-15 # both_param (2 params) 23 | struct-16 # context_param 24 | 25 | # TODO: Remove specific hacks concerning strings and lists? 26 | # This should lead to less code and less "BasePTypes" -------------------------------------------------------------------------------- /tools/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | parsifal 3 | parsifal.byte 4 | picodig 5 | picodig.byte 6 | asn1parse 7 | asn1parse.byte 8 | -------------------------------------------------------------------------------- /tools/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = asn1parse picodig parsifal 3 | 4 | asn1parse_SRCS := asn1parse.ml 5 | picodig_SRCS := picodig.ml 6 | parsifal_SRCS := parsifal_main.ml 7 | 8 | # comment this line if not using camlp4 9 | # USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix result lwt lwt.unix str calendar zarith cryptokit \ 16 | parsifal_syntax parsifal_core parsifal_lwt parsifal_crypto \ 17 | parsifal_net parsifal_formats parsifal_ssl parsifal_kerby parsifal_pgp 18 | 19 | CAMLIDL_DIR = `$(OCAMLFIND) query camlidl` 20 | 21 | # use the following variables to add extra flags (not guessed by ocamlfind) 22 | EXTRA_OCAMLOPT_CC_FLAGS = 23 | # EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 24 | EXTRA_OCAMLOPT_LD_FLAGS = ../kerby/build/krb5_stubs.o ../kerby/build/krb5_functions.o -cclib -lkrb5 -cclib -lk5crypto -ccopt "-L $(CAMLIDL_DIR)" -cclib -lcamlidl -cclib -lmylzma -cclib -lmytiano -ccopt -Lbuild/ 25 | EXTRA_OCAMLC_CC_FLAGS = 26 | # EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 27 | EXTRA_OCAMLC_LD_FLAGS = 28 | 29 | BUILD_DIR = build 30 | 31 | 32 | include ../Makefile.ocaml 33 | 34 | -------------------------------------------------------------------------------- /tools/test/https-secrets.txt: -------------------------------------------------------------------------------- 1 | # SSL/TLS secrets log file, generated by NSS 2 | RSA 41bf39e9ba06b124 03016ff9e12674fcffe96da45f9285675e4bcf31d730487c3fece61609543eab116814d4529e4f167815ce8599373385 3 | CLIENT_RANDOM 3cc65ff9950bcedf4f84ac7931334e304b0f7714d164b99eb3bede5386f63e60 b35778a6ef05212ff381ef0142f517e43eafe25664df574ae8a2fb8ba089b714f12b25d32cbd893a10cf2c0995dad9f7 4 | RSA 0b6ada889223c742 03013f45368dba11dece4c79519141fb72461411f3d06337fcca662d508fdc26b1f79285ca1eee02511bd70e21838dbb 5 | CLIENT_RANDOM c936a50e5b7a5b64376a92ce06b1666a230a7f5ddaf95305ee234aaa44c657cc 9747055e35c51039129b09a856d380e8507827ecb03e122d25f3632a0b0c6d0736eafe7da1f5fe68978a2e1a33458094 6 | RSA 51150c5f871b1343 0301fc617bf0a5e884ea450945d09e99fe14e8877617fdd63cedfe0d569d537ea459d335b642a1c5a7d608aecd1efc95 7 | CLIENT_RANDOM 6931fd22d26f6416118dd0ad76d01bf960bcc11dd677d70745b872d0cb95602e 01f414029a0a0c446aa783bb7ec2dc9f482f205880be92428ab4ac253772f8ffb8eba7625d1f40ed3c2141ea044547b9 8 | RSA 82144bcbb755aed1 03015be3054f227f6c7debab564bddf8d01ff918d7d0dd30885e46b9e12ea38b6befe82d6e468d3cb23c147340f77880 9 | CLIENT_RANDOM b77aec419c9a138e5b9967514fc9b50b7ca73c1eabff53d712ba22c3236c9f85 26e6332b021c6af55d45d5883cdcc0c51ffbcb7245381dbeb042653701a9bd0ac91a24c3083e60de700dc580c7bc9f34 10 | RSA 5c6385908182ad29 0301b9f3352500816e837d7e2e445a53cc85073b6228b8f91c19941697147baab7ddbc18c9e2e035879edc9ef4ae700d 11 | CLIENT_RANDOM ec298367fdffcd46a1927f6206b826a9291b802ffb277df92302db46a0fb5879 2b887c57299a63a44622ddfb7144a2180ac4198a83061d7f53276b1d3ae39dbe83b48a66554577e78de1c6c8cf7ef337 12 | RSA 8dccbe0b54905b52 03012fb710db8c199b2b69cc48bc6a5c8141f95d227387115f720d57f0f71f1aecd16670d16c8e4f6f0466f297a14916 13 | CLIENT_RANDOM 54738ba19c8ef6900867fbaa897d5791cc4c95d86f02b596953cfbebb8ea5c61 a9b6f98651f9673697b2038e791566454a235a532f6b5b7556c3f13cf4586a987b1e0b869571cf2672ee51c69a33c413 14 | -------------------------------------------------------------------------------- /tools/test/https.pcap: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/tools/test/https.pcap -------------------------------------------------------------------------------- /tools/test/tls-decrypt-test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ../parsifal --pcap-tcp 8080 -T tls https.pcap | diff -qs - tcp-raw-records.txt 4 | ../parsifal --pcap-tcp 8080 -T tls https.pcap --always-enrich | diff -qs - tcp-records.txt 5 | 6 | ../parsifal -p 8080 -T pcap-tls https.pcap --always-enrich | diff -qs - pcap-encrypted-tls-records.txt 7 | ../parsifal -p 8080 -T pcap-tls https.pcap --keylogfile https-secrets.txt --always-enrich | diff -qs - pcap-tls-records.txt 8 | 9 | ../parsifal --pcap-tls 8080 https.pcap --keylogfile https-secrets.txt --always-enrich -T string | diff -qs - tls-records.txt 10 | -------------------------------------------------------------------------------- /tools/test/tls-records.txt: -------------------------------------------------------------------------------- 1 | value { 2 | value[0] { 3 | value[0][0]: "GET / HTTP/1.1\x0d\nHost: localhost:8080\x0d\nUser-Agent: Mozilla/5.0 (X11; Li..." (301 bytes) 4 | value[0][1]: "\nSECRET !!\n" (11 bytes) 5 | } 6 | value[1] { 7 | value[1][0]: "" (0 byte) 8 | value[1][1]: "\n" (1 bytes) 9 | } 10 | } 11 | 12 | -------------------------------------------------------------------------------- /toplevel.ml: -------------------------------------------------------------------------------- 1 | (* core *) 2 | open Parsifal 3 | open BasePTypes 4 | open PTypes 5 | open Asn1Engine 6 | open Asn1PTypes 7 | open Base64 8 | open Crc 9 | open Json 10 | open ZLib 11 | 12 | (* crypto *) 13 | open CryptoUtil 14 | open DHKey 15 | open DSAKey 16 | open Pkcs1 17 | open Pkcs7 18 | open RandomEngine 19 | open X509Basics 20 | open X509Extensions 21 | open X509 22 | 23 | (* format *) 24 | open Tar 25 | open Png 26 | open Dvi 27 | open Pe 28 | open Lzma 29 | open Tiano 30 | open Guid 31 | open Uefi_fv 32 | 33 | (* net *) 34 | open Dns 35 | open Mrt 36 | open Pcap 37 | open PcapContainers 38 | 39 | (* openpgp *) 40 | open Libpgp 41 | 42 | (* lwt *) 43 | open LwtUtil 44 | 45 | (* ssl *) 46 | open TlsEnums 47 | open Tls 48 | open TlsCrypto 49 | open TlsDatabase 50 | open TlsEngineNG 51 | open Ssl2 52 | open AnswerDump 53 | -------------------------------------------------------------------------------- /toplevel.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | 6 | # Script initialization 7 | 8 | PROGNAME=$0 9 | 10 | error () { 11 | echo "Error: $1" >&2 12 | echo "Usage: $0 [parsifal dir]" >&2 13 | exit 1 14 | } 15 | 16 | info () { 17 | [ -z "$VERBOSE" ] || echo "[INFO] $1" >&2 18 | } 19 | 20 | PARSIFAL_DIR=$1 21 | [ -z "$PARSIFAL_DIR" ] && PARSIFAL_DIR="$(dirname "$PROGNAME")" 22 | 23 | [ -f "$PARSIFAL_DIR/Makefile.ocaml" ] || error "$PARSIFAL_DIR does not seem to be a directory containing Parsifal." 24 | 25 | 26 | 27 | info "Compiling everything if necessary" 28 | cd "$PARSIFAL_DIR" 29 | make libs 30 | cd - 31 | 32 | rlwrap ocaml -init "$PARSIFAL_DIR/toplevel.ml" \ 33 | -I /usr/lib/ocaml/lwt \ 34 | -I /usr/lib/ocaml/cryptokit \ 35 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_core" \ 36 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_crypto" \ 37 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_net" \ 38 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_formats" \ 39 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_lwt" \ 40 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_ssl" \ 41 | -I "$PARSIFAL_DIR/usrlibocaml/parsifal_pgp" \ 42 | unix.cma nums.cma bigarray.cma lwt.cma cryptokit.cma lwt-unix.cma \ 43 | "$PARSIFAL_DIR"/usrlibocaml/parsifal_{core,crypto,net,formats,lwt,ssl,pgp}/*.cma 44 | -------------------------------------------------------------------------------- /tutorial/.gitignore: -------------------------------------------------------------------------------- 1 | *.ltx.out 2 | tutorial.aux 3 | tutorial.log 4 | tutorial.blg 5 | tutorial.bbl 6 | tutorial.toc 7 | tutorial.snm 8 | tutorial.nav 9 | tutorial.out 10 | tutorial.vrb 11 | tutorial.pdf 12 | -------------------------------------------------------------------------------- /tutorial/2014-03-01--tutorial.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/tutorial/2014-03-01--tutorial.pdf -------------------------------------------------------------------------------- /tutorial/Makefile: -------------------------------------------------------------------------------- 1 | all: tutorial.pdf 2 | 3 | tutorial.pdf: tutorial.tex 4 | @pdflatex -halt-on-error $< > $*.ltx.out 2>&1 || (cat $*.ltx.out && exit 1) 5 | @grep -q '\(There were undefined references\|Label(s) may have changed\)' $*.ltx.out || pdflatex $< > $*.ltx.out 2>&1 6 | @while grep -q 'Label(s) may have changed' $*.ltx.out; do \ 7 | pdflatex $< > $*.ltx.out 2>&1; \ 8 | done 9 | @cat $*.ltx.out 10 | @rm -f $*.ltx.out 11 | 12 | 13 | clean: 14 | rm -f tutorial.pdf *.log *.aux *.blg *.bbl *.vrb *.snm *.nav *.out *.toc 15 | -------------------------------------------------------------------------------- /tutorial/csr-steps/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | csr1 3 | csr2 4 | csr3 5 | *.byte 6 | -------------------------------------------------------------------------------- /tutorial/csr-steps/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = csr1 csr2 csr3 3 | 4 | csr1_SRCS := csr1.ml 5 | csr2_SRCS := csr2.ml 6 | csr3_SRCS := csr3.ml 7 | 8 | # comment this line if not using camlp4 9 | USE_CAMLP4 = yes 10 | 11 | CC = gcc 12 | 13 | # use the following lines to guess .cmxa files from libs names. 14 | # remember, libs are always lowercase 15 | OCAML_LIBS = unix str zarith cryptokit parsifal_syntax parsifal_core parsifal_crypto 16 | 17 | # use the following variables to add extra flags (not guessed by ocamlfind) 18 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 19 | EXTRA_OCAMLOPT_LD_FLAGS = 20 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 21 | EXTRA_OCAMLC_LD_FLAGS = 22 | 23 | BUILD_DIR = build 24 | 25 | 26 | include ../../Makefile.ocaml 27 | 28 | -------------------------------------------------------------------------------- /tutorial/csr-steps/csr1.ml: -------------------------------------------------------------------------------- 1 | open Asn1PTypes 2 | open X509Basics 3 | open X509 4 | 5 | asn1_struct certificationRequestInfo = { 6 | version : der_smallint; 7 | name : distinguishedName; 8 | subjectPublicKeyInfo : subjectPublicKeyInfo; 9 | attributes : der_object; 10 | } 11 | 12 | asn1_struct certificationRequest = { 13 | certificationRequestInfo : certificationRequestInfo; 14 | signatureAlgorithm : algorithmIdentifier; 15 | signatureValue : bitstring_container of signature(signatureType_of_algo signatureAlgorithm) 16 | } 17 | 18 | let _ = 19 | print_endline "Hello, world!" 20 | -------------------------------------------------------------------------------- /tutorial/csr-steps/csr2.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Asn1PTypes 3 | open X509Basics 4 | open X509 5 | 6 | asn1_struct certificationRequestInfo = { 7 | version : der_smallint; 8 | name : distinguishedName; 9 | subjectPublicKeyInfo : subjectPublicKeyInfo; 10 | attributes : der_object; 11 | } 12 | 13 | asn1_struct certificationRequest = { 14 | certificationRequestInfo : certificationRequestInfo; 15 | signatureAlgorithm : algorithmIdentifier; 16 | signatureValue : bitstring_container of signature(signatureType_of_algo signatureAlgorithm) 17 | } 18 | 19 | let _ = 20 | if Array.length Sys.argv <> 2 then failwith "Argument expected" 21 | let input = string_input_of_filename Sys.argv.(1) in 22 | let csr = parse_certificationRequest input in 23 | print_endline (print_value (value_of_certificationRequest csr)) 24 | -------------------------------------------------------------------------------- /tutorial/csr-steps/csr3.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open Asn1PTypes 3 | open X509Basics 4 | open X509 5 | open Pkcs1 6 | 7 | asn1_struct certificationRequestInfo = { 8 | version : der_smallint; 9 | name : distinguishedName; 10 | subjectPublicKeyInfo : subjectPublicKeyInfo; 11 | attributes : der_object; 12 | } 13 | 14 | asn1_struct certificationRequest = { 15 | certificationRequestInfo : certificationRequestInfo; 16 | signatureAlgorithm : algorithmIdentifier; 17 | signatureValue : bitstring_container of signature(signatureType_of_algo signatureAlgorithm) 18 | } 19 | 20 | let check_rsa_sig csr = 21 | let csr_raw = exact_dump dump_certificationRequestInfo csr.certificationRequestInfo in 22 | match csr.certificationRequestInfo.subjectPublicKeyInfo.subjectPublicKey, csr.signatureValue with 23 | | RSA {p_modulus = n; p_publicExponent = e}, RSASignature s -> 24 | (try ignore (Pkcs1.raw_verify 1 csr_raw s n e); true with Pkcs1.PaddingError -> false) 25 | | _ -> failwith "Unknown signature" 26 | 27 | let check_no_nullchar csr = 28 | let dn = csr.certificationRequestInfo.name in 29 | try 30 | ignore (String.index (string_of_distinguishedName dn) '\x00'); 31 | false 32 | with Not_found -> true 33 | 34 | 35 | let _ = 36 | if Array.length Sys.argv <> 2 then failwith "Argument expected" 37 | let input = string_input_of_filename Sys.argv.(1) in 38 | let csr = parse_certificationRequest input in 39 | if not (check_no_nullchar csr) 40 | then print_endline "Null character in DN"; 41 | if not (check_rsa_sig csr) 42 | then print_endline "Invalid RSA signature" 43 | -------------------------------------------------------------------------------- /tutorial/dns-steps/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | dns1 3 | dns2 4 | dns3 5 | dns4 6 | dns5 7 | dns6 8 | dns7 9 | *.byte 10 | -------------------------------------------------------------------------------- /tutorial/dns-steps/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = dns1 dns2 dns3 dns4 dns5 dns6 dns7 # dns8 dns9 3 | 4 | dns1_SRCS := dns1.ml 5 | dns2_SRCS := dns2.ml 6 | dns3_SRCS := dns3.ml 7 | dns4_SRCS := dns4.ml 8 | dns5_SRCS := dns5.ml 9 | dns6_SRCS := dns6.ml 10 | dns7_SRCS := dns7.ml 11 | # dns8_SRCS := dns8.ml 12 | # dns9_SRCS := dns9.ml 13 | 14 | # comment this line if not using camlp4 15 | USE_CAMLP4 = yes 16 | 17 | CC = gcc 18 | 19 | # use the following lines to guess .cmxa files from libs names. 20 | # remember, libs are always lowercase 21 | OCAML_LIBS = unix str parsifal_syntax parsifal_core 22 | 23 | # use the following variables to add extra flags (not guessed by ocamlfind) 24 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 25 | EXTRA_OCAMLOPT_LD_FLAGS = 26 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 27 | EXTRA_OCAMLC_LD_FLAGS = 28 | 29 | BUILD_DIR = build 30 | 31 | 32 | include ../../Makefile.ocaml 33 | -------------------------------------------------------------------------------- /tutorial/examples/aliases.ml: -------------------------------------------------------------------------------- 1 | alias ustar_magic = magic["ustar"] 2 | alias tar_file = list of tar_entry 3 | 4 | struct atv_content = { 5 | attributeType : der_oid; 6 | attributeValue : der_object 7 | } 8 | asn1_alias atv 9 | asn1_alias rdn = set_of atv 10 | asn1_alias distinguishedName = seq_of rdn 11 | -------------------------------------------------------------------------------- /tutorial/examples/asn1_dn.ml: -------------------------------------------------------------------------------- 1 | struct atv_content = { 2 | attributeType : der_oid; 3 | attributeValue : der_object 4 | } 5 | asn1_alias atv 6 | asn1_alias rdn = set_of atv (* min = 1 *) 7 | asn1_alias distinguishedName = seq_of rdn 8 | -------------------------------------------------------------------------------- /tutorial/examples/enum_tls_version.ml: -------------------------------------------------------------------------------- 1 | enum tls_version (16, UnknownVal V_Unknown) = 2 | | 0x0002 -> V_SSLv2, "SSLv2" 3 | | 0x0300 -> V_SSLv3, "SSLv3" 4 | | 0x0301 -> V_TLSv1, "TLSv1.0" 5 | | 0x0302 -> V_TLSv1_1, "TLSv1.1" 6 | | 0x0303 -> V_TLSv1_2, "TLSv1.2" 7 | -------------------------------------------------------------------------------- /tutorial/examples/struct_tls_alert.ml: -------------------------------------------------------------------------------- 1 | enum tls_alert_level (8, UnknownVal AL_Unknown) = 2 | | 1 -> AL_Warning, "Warning" 3 | | 2 -> AL_Fatal, "Fatal" 4 | 5 | 6 | enum tls_alert_type (8, UnknownVal AT_Unknown) = 7 | | 0 -> AT_CloseNotify, "CloseNotify" 8 | | 10 -> AT_UnexpectedMessage, "UnexpectedMessage" 9 | | 20 -> AT_BadRecordMAC, "BadRecordMAC" 10 | | 21 -> AT_DecryptionFailed, "DecryptionFailed" (* Reserved *) 11 | | 22 -> AT_RecordOverflow, "RecordOverflow" 12 | | 30 -> AT_DecompressionFailure, "DecompressionFailure" 13 | | 40 -> AT_HandshakeFailure, "HandshakeFailure" 14 | | 41 -> AT_NoCertificate, "NoCertificate" (* Reserved *) 15 | | 42 -> AT_BadCertificate, "BadCertificate" 16 | | 43 -> AT_UnsupportedCertificate, "UnsupportedCertificate" 17 | | 44 -> AT_CertificateRevoked, "CertificateRevoked" 18 | | 45 -> AT_CertificateExpired, "CertificateExpired" 19 | | 46 -> AT_CertificateUnknown, "CertificateUnknown" 20 | | 47 -> AT_IllegalParameter, "IllegalParameter" 21 | | 48 -> AT_UnknownCA, "UnknownCA" 22 | | 49 -> AT_AccessDenied, "AccessDenied" 23 | | 50 -> AT_DecodeError, "DecodeError" 24 | | 51 -> AT_DecryptError, "DecryptError" 25 | | 60 -> AT_ExportRestriction, "ExportRestriction" (* Reserved *) 26 | | 70 -> AT_ProtocolVersion, "ProtocolVersion" 27 | | 71 -> AT_InsufficientSecurity, "InsufficientSecurity" 28 | | 80 -> AT_InternalError, "InternalError" 29 | | 90 -> AT_UserCanceled, "UserCanceled" 30 | | 100 -> AT_NoRenegotiation, "NoRenegotiation" 31 | | 110 -> AT_UnsupportedExtension, "UnsupportedExtension" 32 | | 111 -> AT_CertificateUnobtainable, "CerttificateUnobtainable" 33 | | 112 -> AT_UnrecognizedName, "UnrecognizedName" 34 | | 113 -> AT_BadCertificateStatusResponse, "BadCertificateStatusResponse" 35 | | 114 -> AT_BadCertificateHashValue, "BadCertificateHashValue" 36 | | 115 -> AT_UnknownPSKIdentity, "UnknownPSKIdentity" 37 | 38 | struct tls_alert = 39 | { 40 | alert_level : tls_alert_level; 41 | alert_type : tls_alert_type 42 | } 43 | -------------------------------------------------------------------------------- /tutorial/examples/union_bgp_as_path_segment.ml: -------------------------------------------------------------------------------- 1 | union autonomous_system [enrich] (UnparsedAS) = 2 | | 16 -> AS16 of uint16 3 | | 32 -> AS32 of uint32 4 | 5 | struct bgp_as_path_segment [param as_size] = 6 | { 7 | path_segment_type : uint8; 8 | path_segment_length : uint8; 9 | path_segment_value : list(path_segment_length) of autonomous_system(as_size) 10 | } 11 | -------------------------------------------------------------------------------- /tutorial/png-steps/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | png1 3 | png2 4 | png3 5 | png4 6 | png5 7 | png6 8 | png7 9 | *.byte 10 | -------------------------------------------------------------------------------- /tutorial/png-steps/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = png1 png2 png3 png4 png5 png6 # png7 3 | 4 | png1_SRCS := png1.ml 5 | png2_SRCS := png2.ml 6 | png3_SRCS := png3.ml 7 | png4_SRCS := png4.ml 8 | png5_SRCS := png5.ml 9 | png6_SRCS := png6.ml 10 | png7_SRCS := png7.ml 11 | 12 | 13 | # comment this line if not using camlp4 14 | USE_CAMLP4 = yes 15 | 16 | CC = gcc 17 | 18 | # use the following lines to guess .cmxa files from libs names. 19 | # remember, libs are always lowercase 20 | OCAML_LIBS = unix str parsifal_syntax parsifal_core 21 | 22 | # use the following variables to add extra flags (not guessed by ocamlfind) 23 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 24 | EXTRA_OCAMLOPT_LD_FLAGS = 25 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 26 | EXTRA_OCAMLC_LD_FLAGS = 27 | 28 | BUILD_DIR = build 29 | 30 | 31 | include ../../Makefile.ocaml 32 | -------------------------------------------------------------------------------- /tutorial/png-steps/png1.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open PTypes 3 | 4 | 5 | struct png_file = { 6 | png_magic : magic("\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"); 7 | png_content : binstring; 8 | } 9 | 10 | 11 | let _ = 12 | try 13 | let input = string_input_of_filename Sys.argv.(1) in 14 | let png_file = parse_png_file input in 15 | print_endline (print_value (value_of_png_file png_file)); 16 | exit 0 17 | with 18 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 19 | | e -> prerr_endline (Printexc.to_string e); exit 1 20 | -------------------------------------------------------------------------------- /tutorial/png-steps/png2.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | struct png_chunk = { 7 | chunk_size : uint32; 8 | chunk_type : string(4); 9 | chunk_data : binstring(chunk_size); 10 | chunk_crc : uint32; 11 | } 12 | 13 | struct png_file = { 14 | png_magic : magic("\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"); 15 | chunks : list of png_chunk; 16 | } 17 | 18 | 19 | let _ = 20 | try 21 | let input = string_input_of_filename Sys.argv.(1) in 22 | let png_file = parse_png_file input in 23 | print_endline (print_value (value_of_png_file png_file)); 24 | exit 0 25 | with 26 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 27 | | e -> prerr_endline (Printexc.to_string e); exit 1 28 | -------------------------------------------------------------------------------- /tutorial/png-steps/png3.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | struct png_chunk = { 7 | chunk_size : uint32; 8 | chunk_type : string(4); 9 | chunk_data : binstring(chunk_size); 10 | chunk_crc : uint32; 11 | } 12 | 13 | struct png_file = { 14 | png_magic : magic("\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"); 15 | chunks : list of png_chunk; 16 | } 17 | 18 | 19 | let is_chunk_critical c = ((int_of_char c.chunk_type.[0]) land 0x20) = 0 20 | 21 | let clean_png_file png_file = 22 | let new_chunks = List.filter is_chunk_critical png_file.chunks in 23 | { png_file with chunks = new_chunks } 24 | 25 | 26 | let display filename = 27 | let input = string_input_of_filename filename in 28 | let png_file = parse_png_file input in 29 | print_endline (print_value (value_of_png_file png_file)) 30 | 31 | let normalize src dst = 32 | let input = string_input_of_filename src in 33 | let png_file = parse_png_file input in 34 | let new_png_file = clean_png_file png_file in 35 | 36 | let output_file = open_out dst in 37 | let output = POutput.create () in 38 | dump_png_file output new_png_file; 39 | POutput.output_buffer output_file output 40 | 41 | 42 | let _ = 43 | try 44 | match Array.length Sys.argv with 45 | | 2 -> display Sys.argv.(1); exit 0 46 | | 3 -> normalize Sys.argv.(1) Sys.argv.(2); exit 0 47 | | _ -> prerr_endline "Please provide one or two arguments."; exit 1 48 | with 49 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 50 | | e -> prerr_endline (Printexc.to_string e); exit 1 51 | -------------------------------------------------------------------------------- /tutorial/png-steps/png4.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum color_type (8, UnknownVal UnknownColorType) = 7 | | 0 -> Grayscale 8 | | 0x02 -> Truecolor 9 | | 0x03 -> Indexedcolor 10 | | 0x04 -> GrayscaleWithAlphaChannel 11 | | 0x06 -> TruecolorWithAlphaChannel 12 | 13 | enum compression_method (8, UnknownVal UnknownCompressionMethod) = 14 | | 0 -> Deflate 15 | 16 | enum filter_method (8, UnknownVal UnknownFilterMethod) = 17 | | 0 -> AdaptativeFilter 18 | 19 | enum interlace_method (8, UnknownVal UnknownInterlaceMethod) = 20 | | 0 -> NoInterlace 21 | | 0x01 -> Adam7 22 | 23 | struct image_header = { 24 | width : uint32; 25 | height : uint32; 26 | bit_depth : uint8; 27 | color_type : color_type; 28 | compression_method : compression_method; 29 | filter_method : filter_method; 30 | interlace_method : interlace_method; 31 | } 32 | 33 | union chunk_content [enrich] (UnparsedChunkContent) = 34 | | "IHDR" -> ImageHeader of image_header 35 | | "IDAT" -> ImageData of binstring 36 | | "IEND" -> ImageEnd 37 | | "PLTE" -> ImagePalette of list of array(3) of uint8 38 | 39 | 40 | struct png_chunk = { 41 | chunk_size : uint32; 42 | chunk_type : string(4); 43 | chunk_data : container(chunk_size) of chunk_content(chunk_type); 44 | chunk_crc : uint32; 45 | } 46 | 47 | struct png_file = { 48 | png_magic : magic("\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"); 49 | chunks : list of png_chunk; 50 | } 51 | 52 | 53 | let is_chunk_critical c = ((int_of_char c.chunk_type.[0]) land 0x20) = 0 54 | 55 | let clean_png_file png_file = 56 | let new_chunks = List.filter is_chunk_critical png_file.chunks in 57 | { png_file with chunks = new_chunks } 58 | 59 | 60 | let display filename = 61 | let input = string_input_of_filename filename in 62 | let png_file = parse_png_file input in 63 | print_endline (print_value (value_of_png_file png_file)) 64 | 65 | let normalize src dst = 66 | let input = string_input_of_filename src in 67 | let png_file = parse_png_file input in 68 | let new_png_file = clean_png_file png_file in 69 | 70 | let output_file = open_out dst in 71 | let output = POutput.create () in 72 | dump_png_file output new_png_file; 73 | POutput.output_buffer output_file output 74 | 75 | 76 | let _ = 77 | try 78 | match Array.length Sys.argv with 79 | | 2 -> display Sys.argv.(1); exit 0 80 | | 3 -> normalize Sys.argv.(1) Sys.argv.(2); exit 0 81 | | _ -> prerr_endline "Please provide one or two arguments."; exit 1 82 | with 83 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h); exit 1 84 | | e -> prerr_endline (Printexc.to_string e); exit 1 85 | -------------------------------------------------------------------------------- /tutorial/tar-steps/.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | tar1 3 | tar2 4 | tar3 5 | tar4 6 | tar5 7 | tar6 8 | tar7 9 | tar8 10 | tar9 11 | *.byte 12 | -------------------------------------------------------------------------------- /tutorial/tar-steps/Makefile: -------------------------------------------------------------------------------- 1 | # configurable section 2 | TARGETS = tar1 tar2 tar3 tar4 tar5 tar6 tar7 tar8 tar9 3 | 4 | tar1_SRCS := tar1.ml 5 | tar2_SRCS := tar2.ml 6 | tar3_SRCS := tar3.ml 7 | tar4_SRCS := tar4.ml 8 | tar5_SRCS := tar5.ml 9 | tar6_SRCS := tar6.ml 10 | tar7_SRCS := tar7.ml 11 | tar8_SRCS := tar8.ml 12 | tar9_SRCS := tar9.ml 13 | 14 | # comment this line if not using camlp4 15 | USE_CAMLP4 = yes 16 | 17 | CC = gcc 18 | 19 | # use the following lines to guess .cmxa files from libs names. 20 | # remember, libs are always lowercase 21 | OCAML_LIBS = unix result lwt lwt.unix str parsifal_syntax parsifal_core parsifal_lwt 22 | 23 | # use the following variables to add extra flags (not guessed by ocamlfind) 24 | EXTRA_OCAMLOPT_CC_FLAGS = -package parsifal_syntax 25 | EXTRA_OCAMLOPT_LD_FLAGS = 26 | EXTRA_OCAMLC_CC_FLAGS = -package parsifal_syntax 27 | EXTRA_OCAMLC_LD_FLAGS = 28 | 29 | BUILD_DIR = build 30 | 31 | 32 | include ../../Makefile.ocaml 33 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar1.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open PTypes 3 | 4 | 5 | enum file_type (8, UnknownVal UnknownFileType) = 6 | | 0 -> NormalFile 7 | | 0x30 -> NormalFile 8 | | 0x31 -> HardLink 9 | | 0x32 -> SymbolicLink 10 | | 0x33 -> CharacterSpecial 11 | | 0x34 -> BlockSpecial 12 | | 0x35 -> Directory 13 | | 0x36 -> FIFO 14 | | 0x37 -> ContiguousFile 15 | 16 | struct tar_header = 17 | { 18 | file_name : string(100); 19 | file_mode : string(8); 20 | owner_uid : string(8); 21 | owner_gid : string(8); 22 | file_size : string(12); 23 | timestamp : string(12); 24 | checksum : string(8); 25 | file_type : file_type; 26 | linked_file : string(100); 27 | ustar_magic : magic("ustar"); 28 | ustar_magic_padding : binstring(3); 29 | owner_user : string(32); 30 | owner_group : string(32); 31 | device_major : string(8); 32 | device_minor : string(8); 33 | filename_prefix : string(155); 34 | hdr_padding : binstring(12) 35 | } 36 | 37 | let int_of_tarstring octal_value = 38 | let len = String.length octal_value in 39 | if len = 0 40 | then 0 41 | else begin 42 | let real_octal_value = String.sub octal_value 0 (len -1) in 43 | int_of_string ("0o" ^ real_octal_value) 44 | end 45 | 46 | 47 | struct tar_entry = 48 | { 49 | header : tar_header; 50 | file_content : binstring(int_of_tarstring header.file_size); 51 | file_padding : binstring(512 - ((int_of_tarstring header.file_size) mod 512)) 52 | } 53 | 54 | 55 | let rec handle_entry input = 56 | let entry = parse_tar_entry input in 57 | print_endline (print_value (value_of_tar_header entry.header)); 58 | handle_entry input 59 | 60 | let _ = 61 | let input = string_input_of_filename "test.tar" in 62 | handle_entry input 63 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar2.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open PTypes 3 | 4 | 5 | enum file_type (8, UnknownVal UnknownFileType) = 6 | | 0 -> NormalFile 7 | | 0x30 -> NormalFile 8 | | 0x31 -> HardLink 9 | | 0x32 -> SymbolicLink 10 | | 0x33 -> CharacterSpecial 11 | | 0x34 -> BlockSpecial 12 | | 0x35 -> Directory 13 | | 0x36 -> FIFO 14 | | 0x37 -> ContiguousFile 15 | 16 | struct ustar_header = 17 | { 18 | ustar_magic : magic("ustar"); 19 | ustar_magic_padding : binstring(3); 20 | owner_user : string(32); 21 | owner_group : string(32); 22 | device_major : string(8); 23 | device_minor : string(8); 24 | filename_prefix : string(155) 25 | } 26 | 27 | struct tar_header = 28 | { 29 | file_name : string(100); 30 | file_mode : string(8); 31 | owner_uid : string(8); 32 | owner_gid : string(8); 33 | file_size : string(12); 34 | timestamp : string(12); 35 | checksum : string(8); 36 | file_type : file_type; 37 | linked_file : string(100); 38 | optional ustar_header : ustar_header; 39 | hdr_padding : binstring 40 | } 41 | 42 | let int_of_tarstring octal_value = 43 | let len = String.length octal_value in 44 | if len = 0 45 | then 0 46 | else begin 47 | let real_octal_value = String.sub octal_value 0 (len -1) in 48 | int_of_string ("0o" ^ real_octal_value) 49 | end 50 | 51 | 52 | struct tar_entry = 53 | { 54 | header : container(512) of tar_header; 55 | file_content : binstring(int_of_tarstring header.file_size); 56 | file_padding : binstring(512 - ((int_of_tarstring header.file_size) mod 512)) 57 | } 58 | 59 | 60 | let rec handle_entry input = 61 | let entry = parse_tar_entry input in 62 | print_endline (print_value (value_of_tar_header entry.header)); 63 | handle_entry input 64 | 65 | let _ = 66 | let input = string_input_of_filename "test.tar" in 67 | handle_entry input 68 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar3.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum file_type (8, UnknownVal UnknownFileType) = 7 | | 0 -> NormalFile 8 | | 0x30 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | let value_of_tar_numstring v = VInt v 30 | 31 | 32 | struct ustar_header = 33 | { 34 | ustar_magic : magic("ustar"); 35 | ustar_magic_padding : binstring(3); 36 | owner_user : string(32); 37 | owner_group : string(32); 38 | device_major : tar_numstring[8]; 39 | device_minor : tar_numstring[8]; 40 | filename_prefix : string(155) 41 | } 42 | 43 | struct tar_header = 44 | { 45 | file_name : string(100); 46 | file_mode : tar_numstring[8]; 47 | owner_uid : tar_numstring[8]; 48 | owner_gid : tar_numstring[8]; 49 | file_size : tar_numstring[12]; 50 | timestamp : tar_numstring[12]; 51 | checksum : string(8); 52 | file_type : file_type; 53 | linked_file : string(100); 54 | optional ustar_header : ustar_header; 55 | hdr_padding : binstring 56 | } 57 | 58 | 59 | struct tar_entry = 60 | { 61 | header : container(512) of tar_header; 62 | file_content : binstring(header.file_size); 63 | file_padding : binstring(512 - (header.file_size mod 512)) 64 | } 65 | 66 | 67 | let rec handle_entry input = 68 | let entry = parse_tar_entry input in 69 | print_endline (print_value (value_of_tar_header entry.header)); 70 | handle_entry input 71 | 72 | let _ = 73 | let input = string_input_of_filename "test.tar" in 74 | handle_entry input 75 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar4.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum file_type (8, UnknownVal UnknownFileType) = 7 | | 0 -> NormalFile 8 | | 0x30 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | let value_of_tar_numstring v = VInt v 30 | 31 | 32 | type optional_tar_numstring = int option 33 | 34 | let parse_optional_tar_numstring len input = 35 | match try_parse (parse_tar_numstring len) input with 36 | | None -> 37 | drop_bytes len input; 38 | None 39 | | x -> x 40 | 41 | let dump_optional_tar_numstring len buf = function 42 | | None -> POutput.add_char buf '\x00' 43 | | Some v -> dump_tar_numstring len buf v 44 | 45 | let value_of_optional_tar_numstring v = try_value_of value_of_tar_numstring v 46 | 47 | 48 | struct ustar_header = 49 | { 50 | ustar_magic : magic("ustar"); 51 | ustar_magic_padding : binstring(3); 52 | owner_user : string(32); 53 | owner_group : string(32); 54 | device_major : optional_tar_numstring[8]; 55 | device_minor : optional_tar_numstring[8]; 56 | filename_prefix : string(155) 57 | } 58 | 59 | struct tar_header = 60 | { 61 | file_name : string(100); 62 | file_mode : tar_numstring[8]; 63 | owner_uid : tar_numstring[8]; 64 | owner_gid : tar_numstring[8]; 65 | file_size : tar_numstring[12]; 66 | timestamp : tar_numstring[12]; 67 | checksum : string(8); 68 | file_type : file_type; 69 | linked_file : string(100); 70 | optional ustar_header : ustar_header; 71 | hdr_padding : binstring 72 | } 73 | 74 | 75 | struct tar_entry = 76 | { 77 | header : container(512) of tar_header; 78 | file_content : binstring(header.file_size); 79 | file_padding : binstring(512 - (header.file_size mod 512)) 80 | } 81 | 82 | 83 | let rec handle_entry input = 84 | let entry = parse_tar_entry input in 85 | print_endline (print_value (value_of_tar_header entry.header)); 86 | handle_entry input 87 | 88 | let _ = 89 | let input = string_input_of_filename "test.tar" in 90 | handle_entry input 91 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar5.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum file_type (8, UnknownVal UnknownFileType) = 7 | | 0 -> NormalFile 8 | | 0x30 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | let value_of_tar_numstring v = VInt v 30 | 31 | 32 | union optional_tar_numstring [both_param len; enrich] (UnparsedNum of binstring(len)) = 33 | | CharacterSpecial -> Num of tar_numstring[len] 34 | | BlockSpecial -> Num of tar_numstring[len] 35 | 36 | 37 | struct ustar_header [param file_type] = 38 | { 39 | ustar_magic : magic("ustar"); 40 | ustar_magic_padding : binstring(3); 41 | owner_user : string(32); 42 | owner_group : string(32); 43 | device_major : optional_tar_numstring[8](file_type); 44 | device_minor : optional_tar_numstring[8](file_type); 45 | filename_prefix : string(155) 46 | } 47 | 48 | struct tar_header = 49 | { 50 | file_name : string(100); 51 | file_mode : tar_numstring[8]; 52 | owner_uid : tar_numstring[8]; 53 | owner_gid : tar_numstring[8]; 54 | file_size : tar_numstring[12]; 55 | timestamp : tar_numstring[12]; 56 | checksum : string(8); 57 | file_type : file_type; 58 | linked_file : string(100); 59 | optional ustar_header : ustar_header(file_type); 60 | hdr_padding : binstring 61 | } 62 | 63 | 64 | struct tar_entry = 65 | { 66 | header : container(512) of tar_header; 67 | file_content : binstring(header.file_size); 68 | file_padding : binstring(512 - (header.file_size mod 512)) 69 | } 70 | 71 | 72 | let rec handle_entry input = 73 | let entry = parse_tar_entry input in 74 | print_endline (print_value (value_of_tar_header entry.header)); 75 | handle_entry input 76 | 77 | let _ = 78 | let input = string_input_of_filename "test.tar" in 79 | handle_entry input 80 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar6.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum file_type (8, UnknownVal UnknownFileType) = 7 | | 0 -> NormalFile 8 | | 0x30 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | let value_of_tar_numstring v = VInt v 30 | 31 | 32 | union optional_tar_numstring [both_param len; enrich] (UnparsedNum of binstring(len)) = 33 | | CharacterSpecial -> Num of tar_numstring[len] 34 | | BlockSpecial -> Num of tar_numstring[len] 35 | 36 | 37 | type azt_string = string 38 | 39 | let parse_azt_string len input = 40 | let saved_offset = input.cur_offset in 41 | let s = parse_string len input in 42 | try 43 | let index = String.index s '\x00' in 44 | 45 | if String.sub s index (len - index) <> String.make (len - index) '\x00' 46 | then emit_parsing_exception false (CustomException "Unclean AZT String") 47 | { input with cur_offset = saved_offset }; 48 | 49 | String.sub s 0 index; 50 | with Not_found -> s 51 | 52 | let dump_azt_string len buf s = 53 | let missing_len = len - (String.length s) in 54 | POutput.add_string buf s; 55 | POutput.add_string buf (String.make missing_len '\x00') 56 | 57 | let value_of_azt_string s = VString (s, false) 58 | 59 | 60 | struct ustar_header [param file_type] = 61 | { 62 | ustar_magic : magic("ustar"); 63 | ustar_magic_padding : binstring(3); 64 | owner_user : azt_string[32]; 65 | owner_group : azt_string[32]; 66 | device_major : optional_tar_numstring[8](file_type); 67 | device_minor : optional_tar_numstring[8](file_type); 68 | filename_prefix : azt_string[155] 69 | } 70 | 71 | struct tar_header = 72 | { 73 | file_name : azt_string[100]; 74 | file_mode : tar_numstring[8]; 75 | owner_uid : tar_numstring[8]; 76 | owner_gid : tar_numstring[8]; 77 | file_size : tar_numstring[12]; 78 | timestamp : tar_numstring[12]; 79 | checksum : string(8); 80 | file_type : file_type; 81 | linked_file : azt_string[100]; 82 | optional ustar_header : ustar_header(file_type); 83 | hdr_padding : binstring 84 | } 85 | 86 | 87 | struct tar_entry = 88 | { 89 | header : container(512) of tar_header; 90 | file_content : binstring(header.file_size); 91 | file_padding : binstring(512 - (header.file_size mod 512)) 92 | } 93 | 94 | 95 | let rec handle_entry input = 96 | let entry = parse_tar_entry input in 97 | print_endline (print_value (value_of_tar_header entry.header)); 98 | handle_entry input 99 | 100 | let _ = 101 | let input = string_input_of_filename "test.tar" in 102 | handle_entry input 103 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar7.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum file_type (8, UnknownVal UnknownFileType) = 7 | | 0 -> NormalFile 8 | | 0x30 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | let value_of_tar_numstring v = VInt v 30 | 31 | 32 | union optional_tar_numstring [both_param len; enrich] (UnparsedNum of binstring(len)) = 33 | | CharacterSpecial -> Num of tar_numstring[len] 34 | | BlockSpecial -> Num of tar_numstring[len] 35 | 36 | 37 | type azt_string = string 38 | 39 | let parse_azt_string len input = 40 | let saved_offset = input.cur_offset in 41 | let s = parse_string len input in 42 | try 43 | let index = String.index s '\x00' in 44 | 45 | if String.sub s index (len - index) <> String.make (len - index) '\x00' 46 | then emit_parsing_exception false (CustomException "Unclean AZT String") 47 | { input with cur_offset = saved_offset }; 48 | 49 | String.sub s 0 index; 50 | with Not_found -> s 51 | 52 | let dump_azt_string len buf s = 53 | let missing_len = len - (String.length s) in 54 | POutput.add_string buf s; 55 | POutput.add_string buf (String.make missing_len '\x00') 56 | 57 | let value_of_azt_string s = VString (s, false) 58 | 59 | 60 | struct ustar_header [param file_type] = 61 | { 62 | ustar_magic : magic("ustar"); 63 | ustar_magic_padding : binstring(3); 64 | owner_user : azt_string[32]; 65 | owner_group : azt_string[32]; 66 | device_major : optional_tar_numstring[8](file_type); 67 | device_minor : optional_tar_numstring[8](file_type); 68 | filename_prefix : azt_string[155] 69 | } 70 | 71 | struct tar_header = 72 | { 73 | file_name : azt_string[100]; 74 | file_mode : tar_numstring[8]; 75 | owner_uid : tar_numstring[8]; 76 | owner_gid : tar_numstring[8]; 77 | file_size : tar_numstring[12]; 78 | timestamp : tar_numstring[12]; 79 | checksum : string(8); 80 | file_type : file_type; 81 | linked_file : azt_string[100]; 82 | optional ustar_header : ustar_header(file_type); 83 | hdr_padding : binstring 84 | } 85 | 86 | 87 | struct tar_entry = 88 | { 89 | header : container(512) of tar_header; 90 | file_content : binstring(header.file_size); 91 | file_padding : binstring(512 - (header.file_size mod 512)) 92 | } 93 | 94 | 95 | let rec handle_entry input = 96 | let entry = parse_tar_entry input in 97 | print_endline (print_value (value_of_tar_header entry.header)); 98 | handle_entry input 99 | 100 | let _ = 101 | try 102 | let input = string_input_of_filename "test.tar" in 103 | handle_entry input 104 | with 105 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h) 106 | | e -> prerr_endline (Printexc.to_string e) 107 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar8.ml: -------------------------------------------------------------------------------- 1 | open Parsifal 2 | open BasePTypes 3 | open PTypes 4 | 5 | 6 | enum file_type (8, UnknownVal UnknownFileType) = 7 | | 0 -> NormalFile 8 | | 0x30 -> NormalFile 9 | | 0x31 -> HardLink 10 | | 0x32 -> SymbolicLink 11 | | 0x33 -> CharacterSpecial 12 | | 0x34 -> BlockSpecial 13 | | 0x35 -> Directory 14 | | 0x36 -> FIFO 15 | | 0x37 -> ContiguousFile 16 | 17 | 18 | type tar_numstring = int 19 | 20 | let parse_tar_numstring len input = 21 | let octal_value = parse_string (len - 1) input in 22 | drop_bytes 1 input; 23 | try int_of_string ("0o" ^ octal_value) 24 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 25 | 26 | let dump_tar_numstring len buf v = 27 | POutput.bprintf buf "%*.*o\x00" len len v 28 | 29 | let value_of_tar_numstring v = VInt v 30 | 31 | 32 | union optional_tar_numstring [both_param len; enrich] (UnparsedNum of binstring(len)) = 33 | | CharacterSpecial -> Num of tar_numstring[len] 34 | | BlockSpecial -> Num of tar_numstring[len] 35 | 36 | 37 | type azt_string = string 38 | 39 | let parse_azt_string len input = 40 | let saved_offset = input.cur_offset in 41 | let s = parse_string len input in 42 | try 43 | let index = String.index s '\x00' in 44 | 45 | if String.sub s index (len - index) <> String.make (len - index) '\x00' 46 | then emit_parsing_exception false (CustomException "Unclean AZT String") 47 | { input with cur_offset = saved_offset }; 48 | 49 | String.sub s 0 index; 50 | with Not_found -> s 51 | 52 | let dump_azt_string len buf s = 53 | let missing_len = len - (String.length s) in 54 | POutput.add_string buf s; 55 | POutput.add_string buf (String.make missing_len '\x00') 56 | 57 | let value_of_azt_string s = VString (s, false) 58 | 59 | 60 | struct ustar_header [param file_type] = 61 | { 62 | ustar_magic : magic("ustar"); 63 | ustar_magic_padding : binstring(3); 64 | owner_user : azt_string[32]; 65 | owner_group : azt_string[32]; 66 | device_major : optional_tar_numstring[8](file_type); 67 | device_minor : optional_tar_numstring[8](file_type); 68 | filename_prefix : azt_string[155] 69 | } 70 | 71 | let parse_stop_if condition _input = 72 | if condition then raise ParsingStop 73 | 74 | struct tar_header = 75 | { 76 | file_name : azt_string[100]; 77 | parse_checkpoint _last_entry : stop_if(file_name = ""); 78 | file_mode : tar_numstring[8]; 79 | owner_uid : tar_numstring[8]; 80 | owner_gid : tar_numstring[8]; 81 | file_size : tar_numstring[12]; 82 | timestamp : tar_numstring[12]; 83 | checksum : string(8); 84 | file_type : file_type; 85 | linked_file : azt_string[100]; 86 | optional ustar_header : ustar_header(file_type); 87 | hdr_padding : binstring 88 | } 89 | 90 | 91 | struct tar_entry = 92 | { 93 | header : container(512) of tar_header; 94 | file_content : binstring(header.file_size); 95 | file_padding : binstring(512 - (header.file_size mod 512)) 96 | } 97 | 98 | alias tar_file = list of tar_entry 99 | 100 | 101 | let _ = 102 | try 103 | let input = string_input_of_filename "test.tar" in 104 | let entries = parse_tar_file input in 105 | let print_entry entry = print_endline (print_value (value_of_tar_header entry.header)) in 106 | List.iter print_entry entries 107 | with 108 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h) 109 | | e -> prerr_endline (Printexc.to_string e) 110 | -------------------------------------------------------------------------------- /tutorial/tar-steps/tar9.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open LwtUtil 3 | open Parsifal 4 | open BasePTypes 5 | open PTypes 6 | 7 | 8 | enum file_type (8, UnknownVal UnknownFileType) = 9 | | 0 -> NormalFile 10 | | 0x30 -> NormalFile 11 | | 0x31 -> HardLink 12 | | 0x32 -> SymbolicLink 13 | | 0x33 -> CharacterSpecial 14 | | 0x34 -> BlockSpecial 15 | | 0x35 -> Directory 16 | | 0x36 -> FIFO 17 | | 0x37 -> ContiguousFile 18 | 19 | 20 | type tar_numstring = int 21 | 22 | let parse_tar_numstring len input = 23 | let octal_value = parse_string (len - 1) input in 24 | drop_bytes 1 input; 25 | try int_of_string ("0o" ^ octal_value) 26 | with _ -> raise (ParsingException (CustomException "int_of_string", _h_of_si input)) 27 | 28 | let dump_tar_numstring len buf v = 29 | POutput.bprintf buf "%*.*o\x00" len len v 30 | 31 | let value_of_tar_numstring v = VInt v 32 | 33 | 34 | union optional_tar_numstring [both_param len; enrich] (UnparsedNum of binstring(len)) = 35 | | CharacterSpecial -> Num of tar_numstring[len] 36 | | BlockSpecial -> Num of tar_numstring[len] 37 | 38 | 39 | type azt_string = string 40 | 41 | let parse_azt_string len input = 42 | let saved_offset = input.cur_offset in 43 | let s = parse_string len input in 44 | try 45 | let index = String.index s '\x00' in 46 | 47 | if String.sub s index (len - index) <> String.make (len - index) '\x00' 48 | then emit_parsing_exception false (CustomException "Unclean AZT String") 49 | { input with cur_offset = saved_offset }; 50 | 51 | String.sub s 0 index; 52 | with Not_found -> s 53 | 54 | let dump_azt_string len buf s = 55 | let missing_len = len - (String.length s) in 56 | POutput.add_string buf s; 57 | POutput.add_string buf (String.make missing_len '\x00') 58 | 59 | let value_of_azt_string s = VString (s, false) 60 | 61 | 62 | struct ustar_header [param file_type] = 63 | { 64 | ustar_magic : magic("ustar"); 65 | ustar_magic_padding : binstring(3); 66 | owner_user : azt_string[32]; 67 | owner_group : azt_string[32]; 68 | device_major : optional_tar_numstring[8](file_type); 69 | device_minor : optional_tar_numstring[8](file_type); 70 | filename_prefix : azt_string[155] 71 | } 72 | 73 | let parse_stop_if condition _input = 74 | if condition then raise ParsingStop 75 | 76 | struct tar_header = 77 | { 78 | file_name : azt_string[100]; 79 | parse_checkpoint _last_entry : stop_if(file_name = ""); 80 | file_mode : tar_numstring[8]; 81 | owner_uid : tar_numstring[8]; 82 | owner_gid : tar_numstring[8]; 83 | file_size : tar_numstring[12]; 84 | timestamp : tar_numstring[12]; 85 | checksum : string(8); 86 | file_type : file_type; 87 | linked_file : azt_string[100]; 88 | optional ustar_header : ustar_header(file_type); 89 | hdr_padding : binstring 90 | } 91 | 92 | 93 | struct tar_entry = 94 | { 95 | header : container(512) of tar_header; 96 | file_content : binstring(header.file_size); 97 | file_padding : binstring(512 - (header.file_size mod 512)) 98 | } 99 | 100 | alias tar_file = list of tar_entry 101 | 102 | 103 | let handle_file input = 104 | lwt_parse_wrapper parse_tar_file input >>= fun entries -> 105 | let print_entry entry = print_endline (print_value (value_of_tar_header entry.header)) in 106 | List.iter print_entry entries; 107 | return () 108 | 109 | let _ = 110 | try 111 | Lwt_main.run (input_of_filename "test.tar" >>= handle_file) 112 | with 113 | | ParsingException (e, h) -> prerr_endline (string_of_exception e h) 114 | | e -> prerr_endline (Printexc.to_string e) 115 | -------------------------------------------------------------------------------- /tutorial/tutorial.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picty/parsifal/767a1d558ea6da23ada46d8d96a057514b0aa2a8/tutorial/tutorial.tex -------------------------------------------------------------------------------- /usrlibocaml/parsifal_core: -------------------------------------------------------------------------------- 1 | ../core/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_crypto: -------------------------------------------------------------------------------- 1 | ../crypto/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_formats: -------------------------------------------------------------------------------- 1 | ../formats/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_kerby: -------------------------------------------------------------------------------- 1 | ../kerby/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_lwt: -------------------------------------------------------------------------------- 1 | ../lwt/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_net: -------------------------------------------------------------------------------- 1 | ../net/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_pgp: -------------------------------------------------------------------------------- 1 | ../openpgp/build/ -------------------------------------------------------------------------------- /usrlibocaml/parsifal_ssl: -------------------------------------------------------------------------------- 1 | ../ssl/build -------------------------------------------------------------------------------- /usrlibocaml/parsifal_syntax: -------------------------------------------------------------------------------- 1 | ../syntax/build --------------------------------------------------------------------------------