Raw TCP/IP networking is dangerous for two reasons. It is hard to tell whether the party you think you are talking to is indeed the right one and anyone with access to a subnet through which your data flows can `tap' the wire and listen for sensitive information such as passwords, credit card numbers, etc. Secure Socket Layer (SSL) deals with both problems. It uses certificates to establish the identity of the peer and encryption to make it useless to tap into the wire. SSL allows agents to talk in private and create secure web services.
The SWI-Prolog library(ssl)
library provides an API to
turn a pair of arbitrary Prolog wire streams into SSL powered
encrypted streams. Note that secure protocols such as secure HTTP simply
run the plain protocol over (SSL) encrypted streams.
Cryptography is a difficult topic. If you just want to download documents from an HTTPS server without worrying much about security, http_open/3 will do the job for you. As soon as you have higher security demands we strongly recommend you to read enough background material to understand what you are doing. See section 4 for some remarks regarding this implementation. This The Linux Documentation Project page provides some additional background and tips for managing certificates and keys.
An SSL server and client can be built with the (abstracted) predicate
calls from the table below. The tcp_
predicates are
provided by library(socket)
. The predicate ssl_context/3
defines properties of the SSL connection, while ssl_negotiate/5
establishes the SSL connection based on the wire streams created by the
TCP predicates and the context.
The SSL Server The SSL Client ssl_context/3 ssl_context/3 tcp_socket/1 tcp_accept/3 tcp_connect/3 tcp_open_socket/3 stream_pair/3 ssl_negotiate/5 ssl_negotiate/5
The library is abstracted to communication over streams, and is not
reliant on those streams being directly attached to sockets. The tcp_
calls here are simply the most common way to use the library. Other
two-way communication channels such as (named), pipes can just as easily
be used.
client
.
Otherwise, certificate verification may fail when negotiating a secure
connection.
key_file(+FileName)
option. A certificate file is
obligatory for a server and may be provided for a client if the server
demands the client to identify itself with a client certificate using
the peer_cert(true)
option. If a certificate is provided,
it is necessary to also provide a matching private key via the key_file/1
or key/1 options.
password(+Text)
or
pem_password_hook(:PredicateName)
option.
call(+PredicateName, +SSL, -Password)
and typically unifies Password with a string
containing the password.
require_crl(true)
and provide neither of these options, verification will necessarily fail
require_crl(true)
if you want
CRLs to actually be checked by OpenSSL.
system(root_certificates)
uses a list of trusted root certificates as provided by the OS. See
system_root_certificates/1
for details.
Additional verification of the peer certificate as well as accepting
certificates that are not trusted by the given set can be realised using
the hook
cert_verify_hook(PredicateName)
.
call(PredicateName, +SSL, +ProblemCertificate, +AllCertificates, +FirstCertificate, +Error)
In case the certificate was verified by one of the provided
certifications from the cacert_file
option, Error is
unified with the atom verified
. Otherwise it contains the
error string passed from OpenSSL. Access will be granted iff the
predicate succeeds. See load_certificate/2
for a description of the certificate terms. See cert_accept_any/5
for a dummy implementation that accepts any certificate.
prime256v1
.
certificate_file(FileName)
. Sending is automatic for the
server role and implied if both a certificate and key are supplied for
clients, making this option obsolete.
true
, close the raw streams if the SSL
streams are closed. Default is false
.
sslv2
, sslv3
, sslv23
,
tlsv1
, tlsv1_1
and tlsv1_2
.
disable_ssl_methods
above.
Using this option is discouraged. When using OpenSSL 1.1.0 or later,
this option is ignored, and a version-flexible method is used to
negotiate the connection. Using version-specific methods is deprecated
in recent OpenSSL versions, and this option will become obsolete and
ignored in the future.
call(PredicateName, +SSL0, +HostName, -SSL)
Given the current context SSL0, and the host name of the client request, the predicate computes SSL which is used as the context for negotiating the connection. The first solution is used. If the predicate fails, the default options are used, which are those of the encompassing ssl_context/3 call. In that case, if no default certificate and key are specified, the client connection is rejected.
Role | is one of server or client
and denotes whether the
SSL instance will have a server or client role in the
established connection. |
SSL | is a SWI-Prolog blob of type ssl_context ,
i.e., the type-test for an SSL context is blob(SSL, ssl_context) . |
After a successful handshake and finishing the communication the user
must close SSLRead and SSLWrite, for example using
call_cleanup(close(SSLWrite), close(SSLRead))
. If the SSL
context (created with ssl_context/3
has the option
close_parent(true)
(default false
), closing SSLRead
and
SSLWrite also closes the original PlainRead and PlainWrite
streams. Otherwise these must be closed explicitly by the user.
http_open(HTTPS_url, In, []), ssl_peer_certificate(In, Cert), memberchk(subject(Subject), Cert), memberchk('CN' = CommonName), Subject)
Note that the OpenSSL CA.pl
utility creates certificates
that have a human readable textual representation in front of the PEM
representation. You can use the following to skip to the certificate if
you know it is a PEM certificate:
skip_to_pem_cert(In) :- repeat, ( peek_char(In, '-') -> ! ; skip(In, 0'\n), at_end_of_stream(In), ! ).
revoked(+Serial, DateOfRevocation)
system(root_certificates)
. The list is obtained using an OS
specific process. The current implementation is as follows:
"ROOT"
certificates from the OS.
system_cacert_filename
. The initial value of this flag
is operating system dependent. For security reasons, the flag can only
be set prior to using the SSL library. For example:
:- use_module(library(ssl)). :- set_prolog_flag(system_cacert_filename, '/home/jan/ssl/ca-bundle.crt').
private_key(KeyTerm)
where KeyTerm is a
rsa/8 term representing an RSA key.public_key(KeyTerm)
where KeyTerm is an rsa/8 term
representing an RSA key.Options:
utf8
.
Alternatives are utf8
and octet
.
pkcs1
. Alternatives are pkcs1_oaep
, sslv23
and none
. Note that none
should only be used
if you implement cryptographically sound padding modes in your
application code as encrypting unpadded data with RSA is insecure
sha1
(default), sha224
, sha256
,
sha384
or sha512
octet
.
Alternatives are utf8
and text
.
This predicate is used to compute a sha1WithRSAEncryption signature as follows:
sha1_with_rsa(PemKeyFile, KeyPassword, Data, Signature) :- DigestAlgorithm = sha1, read_key(PemKeyFile, KeyPassword, PrivateKey), sha_hash(Data, Digest, [algorithm(DigestAlgorithm)]), rsa_sign(Key, Digest, Signature, [type(DigestAlgorithm)]). read_key(PemKeyFile, KeyPassword, PrivateKey) :- setup_call_cleanup( open(File, read, In, [type(binary)]), load_private_key(In, Password, Key), close(In).
sha1
(default), sha224
, sha256
,
sha384
or sha512
octet
.
Alternatives are utf8
and text
.
http_open('https:/...', In, [ cert_verify_hook(cert_accept_any) ])
If the IV is not needed for your decryption algorithm (such as aes-128-ecb) then any string can be provided as it will be ignored by the underlying implementation
Options:
utf8
.
Alternatives are utf8
and octet
.
block
. You can disable
padding by supplying
none
here.
?-
evp_encrypt("this is some input", 'aes-128-cbc', "sixteenbyteofkey", "sixteenbytesofiv", CipherText, [])
,
evp_decrypt(CipherText, 'aes-128-cbc', "sixteenbyteofkey", "sixteenbytesofiv", RecoveredText, [])
.
CipherText = <binary string>
RecoveredText = "this is some input".
The SSL package provides several libraries dealing with cryptographic
operations of XML documents. These libraries depend on the sgml
package. These libraries are part of this package because the
sgml
package has no external dependencies and will thus be
available in any SWI-Prolog installation while configuring and building
this ssl
package is much more involved.
This library uses SAML to exchange messages with an Identity Provider to establish assertions about the current user's session. It operates only as the service end, not the identity provider end.
This library is a partial implementation of the XML encryption standard. It implements the decryption part, which is needed by SAML clients.
KeyCallback | may be called as follows:
|
This library deals with XMLDSIG, RSA signed XML documents.
The SignedDOM must be emitted using xml_write/3
or
xml_write_canonical/3. If xml_write/3
is used, the option
layout(false)
is needed to avoid changing the layout of the
SignedInfo
element and the signed DOM, which
will cause the signature to be invalid.
ds:Signature
element contains a valid
signature. Certificate is bound to the certificate that
appears in the element if the signature is valid. It is up to the caller
to determine if the certificate is trusted or not.
Note: The DOM and SignatureDOM must have
been obtained using the load_structure/3
option keep_prefix(true)
otherwise it is impossible to
generate an identical document for checking the signature. See also xml_write_canonical/3.
Using SSL (in this particular case based on the OpenSSL
implementation) to connect to SSL services (e.g., an https://
address) easily gives a false sense of security. This section explains
some of the pitfalls.1We do not
claim to be complete, just to start warning you if security is important
to you. Please make sure you understand (Open)SSL before relying on it..
As stated in the introduction, SSL aims at solving two issues: tapping
information from the wire by means of encryption and make sure that you
are talking to the right address.
Encryption is generally well arranged as long as you ensure that the
underlying SSL library has all known security patches installed and you
use an encryption that is not known to be weak. The Windows version of
SWI-Prolog ships with its own binary of the OpenSSL library. Ensure this
is up-to-date. Most other systems ship with the OpenSSL library and
SWI-Prolog uses the system version. This applies for the binaries we
distribute for MacOSX and Linux, as well as official Linux packages.
Check the origin and version of the OpenSSL libraries if SWI-Prolog was
compiled from source. The OpenSSL library version as reported by
SSLeay_version() is available in the Prolog flag
ssl_library_version
as illustrated below on Ubuntu 14.04.
?- [library(ssl)]. ?- current_prolog_flag(ssl_library_version, X). X = 'OpenSSL 1.0.1f 6 Jan 2014'.
Whether you are talking to the right address is a complicated issue. The core of the validation is that the server provides a certificate that identifies the server. This certificate is digitally signed by another certificate, and ultimately by a root certificate. (There may be additional links in this chain as well, or there may just be one certificate signed by itself) Verifying the peer implies:
The default https client plugin (library(http/http_ssl_plugin)
)
registers the system trusted root certificate with OpenSSL. This is
achieved using the option
cacert_file(system(root_certificates))
of ssl_context/3.
The verification is left to OpenSSL. To the best of our knowledge, the
current (1.0) version of OpenSSL only implements step (1) of the
verification process outlined above. This implies that an attacker that
can control DNS mapping (host name to IP) or routing (IP to physical
machine) can fake to be a secure host as long as they manage to obtain a
certificate that is signed from a recognised authority. Version 1.0.2
supports hostname checking, and will not validate a certificate chain if
the leaf certificate does not match the hostname. 'Match' here is not a
simple string comparison; certificates are allowed (subject to many
rules) to have wildcards in their SubjectAltName field. Care must also
be taken to ensure that the name we are checking against does not
contain embedded NULLs. If SWI-Prolog is compiled against a version of
OpenSSL that does NOT have hostname checking (ie 1.0.0 or earlier), it
will attempt to do the validation itself. This is not guaranteed to be
perfect, and it only supports a small subset of allowed wildcards. If
security is important, use OpenSSL 1.0.2 or higher.
After validation, the predicate ssl_peer_certificate/2 can be used to obtain the peer certificate and inspect its properties.
To do CRL checking, pass require_crl(true) as an option to the ssl_context/3 (or http_open/3) option list. If you do this, a certificate will not be validated unless it can be checked for on a revocation list. There are two options for this:
First, you can pass a list of filenames in as the option crl/1. If the CRL corresponds to an issuer in the chain, and the issued certificate is not on the CRL, then it is assumed to not be revoked. Note that this does NOT prove the certificate is actually trustworthy - the CRL you pass may be out of date! This is quite awkward to get right, since you do not necessarily know in advance what the chain of certificates the other party will present are, so you cannot reasonably be expected to know which CRLs to pass in.
Secondly, you can handle the CRL checking in the cert_verify_hook when the Error is bound to unknown_crl. At this point you can obtain the issuer certificate (also given in the hook), find the CRL distribution point on it (the crl/1 argument), try downloading the CRL (the URL can have literally any protocol, most commonly HTTP and LDAP, but theoretically anything else, too, including the possibility that the certificate has no CRL distribution point given, and you are expected to obtain the CRL by email, fax, or telegraph. Therefore how to actually obtain a CRL is out of scope of this document), load it using load_crl/2, then check to see whether the certificate currently under scrutiny appears in the list of revocations. It is up to the application to determine what to do if the CRL cannot be obtained - either because the protocol to obtain it is not supported or because the place you are obtaining it from is not responding. Just because the CRL server is not responding does not mean that your certificate is safe, of course - it has been suggested that an ideal way to extend the life of a stolen certificate key would be to force a denial of service of the CRL server.
In some cases clients are not really interested in host validation of
the peer and whether or not the certificate can be trusted. In these
cases the client can pass cert_verify_hook(cert_accept_any)
,
calling cert_accept_any/5
which accepts any certificate. Note that this will accept literally ANY
certificate presented - including ones which have expired, have been
revoked, and have forged signatures. This is probably not a good idea!
Applications that exchange sensitive data with e.g., a backend server
typically need to ensure they have a secure connection to their peer. To
do this, first obtain a non-secure connection to the peer (eg via a TCP
socket connection). Then create an SSL context via
ssl_context/3.
For the client initiating the connection, the role is 'client', and you
should pass options host/1
and cacert_file/1
at the very least. If you expect the peer to have a certificate which
would be accepted by your host system, you can pass
cacert_file(system(root_certificates))
, otherwise you will
need a copy of the CA certificate which was used to sign the peer's
certificate. Alternatively, you can pass cert_verify_hook/1
to write your own custom validation for the peer's certificate.
Depending on the requirements, you may also have to provide your /own/
certificate if the peer demands mutual authentication. This is done via
the
certificate_file/1, key_file/1
and either password/1
or
pem_password_hook/1.
Once you have the SSL context and the non-secure stream, you can call ssl_negotiate/5 to obtain a secure stream. ssl_negotiate/5 will raise an exception if there were any certificate errors that could not be resolved.
The peer behaves in a symmetric fashion: First, a non-secure connection is obtained, and a context is created using ssl_context/3 with the role set to server. In the server case, you must provide certificate_file/1 and key_file/1, and then either password/1 or pem_password_hook/1. If you require the other party to present a certificate as well, then peer_cert(true) should be provided. If the peer does not present a certificate, or the certificate cannot be validated as trusted, the connection will be rejected.
By default, revocation is not checked. To enable certificate revocation checking, pass require_crl(true) when creating the SSL context. See section 5 for more information about revocations.
Examples of a simple server and client (server.pl
and
client.pl
as well as a simple HTTPS server (https.pl
)
can be found in the example directory which is located in
doc/packages/examples/ssl
relative to the SWI-Prolog
installation directory. The etc
directory contains example
certificate files as well as a README
on the creation of
certificates using OpenSSL tools.
Accessing an https://
server can be achieved using the
code skeleton below. The line :- use_module(library(http/http_ssl_plugin)).
can be omitted if the development environment is present because the
plugin is dynamically loaded by http_open/3
of the https
scheme is detected. See section
4 for more information about security aspects.
:- use_module(library(http/http_open)). :- use_module(library(http/http_ssl_plugin)). ..., http_open(HTTPS_url, In, []), ...
The SWI-Prolog infrastructure provides two main ways to launch an HTTPS server:
library(http/thread_httpd)
, the server is started
in HTTPS mode by adding an option ssl/1
to
http_server/2.
The argument of ssl/1
is an option list that is passed as
the third argument to ssl_context/3.
library(http/http_unix_daemon)
, an HTTPS server
is started by using the command line argument --https
.
At least two items must be specified as, respectively, options or additional command line arguments:
password
option, the pem_password_hook
callback or, in case of the Unix daemon, via the --pwfile
or
--password
command line options.
Below is an example that uses the self-signed demo certificates distributed with the SSL package. As is typical for publicly accessible HTTPS servers, this version does not require a certificate from the client:
:- use_module(library(http/thread_httpd)). :- use_module(library(http/http_ssl_plugin)). https_server(Port, Options) :- http_server(reply, [ port(Port), ssl([ certificate_file('etc/server/server-cert.pem'), key_file('etc/server/server-key.pem'), password("apenoot1") ]) | Options ]).
The example file https.pl
also provides a server that
does require the client to show its certificate. This provides an
additional level of security, often used to allow a selected set of
clients to perform sensitive tasks.
Note that a single Prolog program can call http_server/2
with different parameters to provide services at several security levels
as described below. These servers can either use their own dispatching
or commonly use http_dispatch/1
and check the port
property of the request to verify they
are called with the desired security level. If a service is approached
at a too low level of security, the handler can deny access or use HTTP
redirect to send the client to to appropriate interface.
The above expects Prolog to be accessible directly from the internet. This is becoming more popular now that services are often deployed using virtualization. If the Prolog services are placed behind a reverse proxy, HTTPS implementation is the task of the proxy server (e.g., Apache or Nginx). The communication from the proxy server to the Prolog server can use either plain HTTP or HTTPS. As plain HTTP is easier to setup and faster, this is typically preferred if the network between the proxy server and Prolog server can be trusted.
Note that the proxy server must decrypt the HTTPS traffic because it must decide on the destination based on the encrypted HTTP header. Port forwarding provides another option to make a server running on a machine that is not directly connected to the internet visible. It is not needed to decrypt the traffic using port forwarding, but it is also not possible to realise virtual hosts or path-based proxy rules.
Virtual hosts for HTTPS are available via Server Name Indication (SNI). This is a TLS extension that allows servers to host different domains from the same IP address. See the sni_hook/1 option of ssl_context/3 for more information.
The development of the SWI-Prolog SSL interface has been sponsored by Scientific Software and Systems Limited. The current version contains contributions from many people. Besides the mentioned authors, Markus Triska has submitted several patches, and improved and documented the integration of this package with the HTTP infrastructure.