#require "netclient,nettls-gnutls";; open Printf let () = Nettls_gnutls.init() let demo1() = (* Get a file listing from an HTTP server, and download the first txt file *) let fs = Nethttp_fs.http_fs "http://ftp.debian.org/debian/" in let files = fs # readdir [] "/" in printf "Files: %s\n%!" (String.concat "," files); let txt = List.find (fun p -> Filename.check_suffix p ".txt") files in let ch = fs # read [] ("/" ^ txt) in let data = Netchannels.string_of_in_obj_channel ch in ch # close_in(); printf "File:\n%s\n\n%!" data let demo2() = (* the same for FTP *) let fs = Netftp_fs.ftp_fs "ftp://ftp.debian.org/debian/" in let files = fs # readdir [] "/" in printf "Files: %s\n%!" (String.concat "," files); let txt = List.find (fun p -> Filename.check_suffix p ".txt") files in let ch = fs # read [] ("/" ^ txt) in let data = Netchannels.string_of_in_obj_channel ch in ch # close_in(); printf "File:\n%s\n\n%!" data (* There are also netfs implementations for local file access (Netfs) and for accessing files via shell login (for an scp-like utility: Shell_fs) *) (* TLS demo: *) let ca = (* AddTrust External Root *) "-----BEGIN CERTIFICATE----- MIIENjCCAx6gAwIBAgIBATANBgkqhkiG9w0BAQUFADBvMQswCQYDVQQGEwJTRTEU MBIGA1UEChMLQWRkVHJ1c3QgQUIxJjAkBgNVBAsTHUFkZFRydXN0IEV4dGVybmFs IFRUUCBOZXR3b3JrMSIwIAYDVQQDExlBZGRUcnVzdCBFeHRlcm5hbCBDQSBSb290 MB4XDTAwMDUzMDEwNDgzOFoXDTIwMDUzMDEwNDgzOFowbzELMAkGA1UEBhMCU0Ux FDASBgNVBAoTC0FkZFRydXN0IEFCMSYwJAYDVQQLEx1BZGRUcnVzdCBFeHRlcm5h bCBUVFAgTmV0d29yazEiMCAGA1UEAxMZQWRkVHJ1c3QgRXh0ZXJuYWwgQ0EgUm9v dDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALf3GjPm8gAELTngTlvt H7xsD821+iO2zt6bETOXpClMfZOfvUq8k+0DGuOPz+VtUFrWlymUWoCwSXrbLpX9 uMq/NzgtHj6RQa1wVsfwTz/oMp50ysiQVOnGXw94nZpAPA6sYapeFI+eh6FqUNzX mk6vBbOmcZSccbNQYArHE504B4YCqOmoaSYYkKtMsE8jqzpPhNjfzp/haW+710LX a0Tkx63ubUFfclpxCDezeWWkWaCUN/cALw3CknLa0Dhy2xSoRcRdKn23tNbE7qzN E0S3ySvdQwAl+mG5aWpYIxG3pzOPVnVZ9c0p10a3CitlttNCbxWyuHv77+ldU9U0 WicCAwEAAaOB3DCB2TAdBgNVHQ4EFgQUrb2YejS0Jvf6xCZU7wO94CTLVBowCwYD VR0PBAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wgZkGA1UdIwSBkTCBjoAUrb2YejS0 Jvf6xCZU7wO94CTLVBqhc6RxMG8xCzAJBgNVBAYTAlNFMRQwEgYDVQQKEwtBZGRU cnVzdCBBQjEmMCQGA1UECxMdQWRkVHJ1c3QgRXh0ZXJuYWwgVFRQIE5ldHdvcmsx IjAgBgNVBAMTGUFkZFRydXN0IEV4dGVybmFsIENBIFJvb3SCAQEwDQYJKoZIhvcN AQEFBQADggEBALCb4IUlwtYj4g+WBpKdQZic2YR5gdkeWxQHIzZlj7DYd7usQWxH YINRsPkyPef89iYTx4AWpb9a/IfPeHmJIZriTAcKhjW88t5RxNKWt9x+Tu5w/Rw5 6wwCURQtjr0W4MHfRnXnJK3s9EK0hZNwEGe6nQY1ShjTK3rMUUKhemPR5ruhxSvC Nr4TDea9Y355e6cJDUCrat2PisP29owaQgVR1EX1n6diIWgVIEM8med8vSTYqZEX c4g/VhsxOBi0cQ+azcgOno4uG+GMmIPLHzHxREzGBHNJdmAPx/i9F4BrLunMTA5a mnkPIAou1Z5jJh5VkpTYghdae9C8x49OhgQ= -----END CERTIFICATE-----" let ca_parsed = match Netascii_armor.parse [ "CERTIFICATE", `Base64 ] (new Netchannels.input_string ca) with | [ _, `Base64 body ] -> body#value | _ -> failwith "parser error" let demo3() = (* For HTTP, TLS is automatically enabled once GnuTLS is initialized. You may want to tune this. Here we restrict the certificates (if you don't change the options, all system-wide certs are trusted). *) let tls_config = Netsys_tls.create_x509_config ~trust:[ `DER [ ca_parsed ] ] ~peer_auth:`Required (module Nettls_gnutls.TLS) in let fs = Nethttp_fs.http_fs ~config_pipeline:(fun p -> let opts = p # get_options in let opts' = { opts with Nethttp_client.tls = Some tls_config } in p # set_options opts' ) "https://www.debian.org/" in let ch = fs # read [] "/sitemap" in let data = Netchannels.string_of_in_obj_channel ch in ch # close_in(); printf "DATA: %s\n\n%!" data let demo4() = (* For FTP, you need to explicitly enable TLS. I haven't found any public FTP server with TLS support though. *) let fs = Netftp_fs.ftp_fs ~tls_enabled:true ~tls_required:true "ftp://host/" in let files = fs # readdir [] "/" in printf "Files: %s\n%!" (String.concat "," files); let txt = List.find (fun p -> Filename.check_suffix p ".txt") files in let ch = fs # read [] ("/" ^ txt) in let data = Netchannels.string_of_in_obj_channel ch in ch # close_in(); printf "File:\n%s\n\n%!" data