(* $Id: netmech_scram.mli 2195 2015-01-01 12:23:39Z gerd $ *)

(** SCRAM mechanism for authentication (RFC 5802) *)

(** This implements SCRAM for SASL and GSSAPI.

    {b This module needs the SHA-1 hash function. In order to use it,
    initialize crypto support, e.g. by including the [nettls-gnutls]
    packages and calling {!Nettls_gnutls.init}.}

    As for all SASL mechanisms in OCamlnet, SASLprep is not automatically
    called. Users of SCRAM should pass user names and passwords through
    {!Netsaslprep.saslprep}.

 *)

type ptype = [ `GSSAPI | `SASL | `HTTP ]
  (** Profile types:
       - [`GSSAPI]: as defined in RFC 5802, the gs2-header is omitted
       - [`SASL]: as defined in RFC 5802
       - [`HTTP]: at the moment this follows draft-ietf-httpauth-scram-auth-03,
         and uses a different [gs2-header]
   *)

type profile =
    { ptype : ptype;
      hash_function : Netsys_digests.iana_hash_fn; (** Which hash function *)
      return_unknown_user : bool;  (** Whether servers exhibit the fact that the
				       user is unknown *)
      iteration_count_limit : int; (** Largest supported iteration number *)
    }
  (** Profile *)

type cb = Netsys_sasl_types.cb
  (** Using the same channel binding type as for SASL *)

type server_error =
    [ `Invalid_encoding
    | `Extensions_not_supported
    | `Invalid_proof
    | `Channel_bindings_dont_match
    | `Server_does_support_channel_binding
    | `Channel_binding_not_supported
    | `Unsupported_channel_binding_type
    | `Unknown_user
    | `Invalid_username_encoding
    | `No_resources
    | `Other_error
    | `Extension of string
    ]
  (** Error codes of this protocol *)

type client_session
  (** Session context for clients *)


type server_session
  (** Session context for servers *)


exception Invalid_encoding of string * string
  (** Raised by clients when something cannot be decoded. First string
      is an error message, the second string the raw message that cannot
      be decoded
   *)

exception Invalid_username_encoding of string * string
  (** Raised by clients when the username does not match the requirements.
      Arguments as for [Invalid_encoding].
   *)

exception Extensions_not_supported of string * string
  (** Raised by clients when the server enables an unsupported extension.
      Arguments as for [Invalid_encoding].
   *)

exception Protocol_error of string
  (** Raised by clients when the server violates the protocol. The argument
      is a message.
   *)

exception Invalid_server_signature
  (** Raised by clients when the signature sent by the server is invalid
      (i.e. the server does not know the client password)
   *)

exception Server_error of server_error
  (** Raised by clients when the server sent an error code *)


val profile : ?return_unknown_user:bool -> ?iteration_count_limit:int ->
              ptype -> Netsys_digests.iana_hash_fn -> profile
  (** Creates a profile *)

val string_of_server_error : server_error -> string
val server_error_of_string : string -> server_error
  (** Conversion *)

val mechanism_name : profile -> string
  (** The official name of the mechanism *)


(** {2 Clients} *)

(** The idea is to create a client session [s] first. The functions
    [client_emit_flag] and [client_recv_flag] indicate now whether
    the client needs to emit a new message, or whether it needs to
    receive a message, respectively. Emission is done by [client_emit_message],
    reception by [client_recv_message]. If everything goes well, the
    protocol state advances, and finally [client_finish_flag] is true.
    This indicates that the client is authenticated and that the server
    knows the client's password. If an error occurs, an exception is
    raised (see above for possibilities), and [client_error_flag] signals
    [true].
 *)

val create_client_session :
      ?nonce: string ->
      profile -> string -> string -> client_session
  (** [create_client_session p username password]: Creates a new client
      session for profile [p] so that the client authenticates as user
      [username], and proves its identity with the given [password].
   *)

val create_client_session2 :
    ?nonce:string -> 
    profile -> string -> string -> string -> client_session
  (** [create_client_session p username authzname password]: Like
      [create_client_session], but also sets the authorization name
      (only processed for the SASL profile).
   *)

val client_configure_channel_binding : client_session -> cb -> unit
  (** Sets whether to request channel binding.
   *)

val client_emit_flag : client_session -> bool
  (** Whether [client_emit_message] can now be called *)

val client_recv_flag : client_session -> bool
  (** Whether [client_recv_message] can now be called *)

val client_finish_flag : client_session -> bool
  (** Whether the client is authenticated and the server verified *)

val client_error_flag : client_session -> bool
  (** Whether an error occurred, and the protocol cannot advance anymore *)

val client_channel_binding : client_session -> cb
  (** Returns the channel binding *)

val client_emit_message : client_session -> string
  (** Emits the next message to be sent to the server *)

val client_emit_message_kv : client_session -> 
                               string option * (string * string) list
  (** Emits the next message to be sent to the server. The message is not
      encoded as a single string, but as [(gs2_opt, kv)] where
      [gs2_opt] is the optional GS2 header (the production [gs2-header] from
      the RFC), and [kv] contains the parameters as key/value pairs.
   *)

val client_recv_message : client_session -> string -> unit
  (** Receives the next message from the server *)

val client_protocol_key : client_session -> string option
  (** The 128-bit protocol key for encrypting messages. This is available 
      as soon as the second client message is emitted.
   *)

val client_user_name : client_session -> string
  (** The user name *)

val client_authz_name : client_session -> string
  (** The authorization name *)

val client_password : client_session -> string
  (** The password *)

val client_export : client_session -> string
val client_import : string -> client_session
  (** Exports a client session as string, and imports the string again.

      The export format is just a marshalled Ocaml value.
   *)

val client_prop : client_session -> string -> string
  (** Returns a property of the client (or Not_found):
       - "snonce"
       - "cnonce"
       - "salt"
       - "i" (iteration_count)
       - "protocol_key"
   *)




(** {2 Servers} *)

(** The idea is to create a server session [s] first. The functions
    [server_emit_flag] and [server_recv_flag] indicate now whether
    the server needs to emit a new message, or whether it needs to
    receive a message, respectively. Emission is done by [server_emit_message],
    reception by [server_recv_message]. If everything goes well, the
    protocol state advances, and finally [server_finish_flag] is true.
    This indicates that the client could be authenticated.

    If an error occurs, {b no} exception is raised, and the protocol
    advances nevertheless, and finally the server sends an error token
    to the client. After this, [server_error_flag] returns true.
 *)

type credentials =
  [ `Salted_password of string * string * int
  | `Stored_creds of string * string * string * int
  ]
  (** Two forms of providing credentials:
       - [`Salted_password(spw,salt,iteration_count)]: get the
         salted password with
         [spw = salt_password h password salt iteration_count]
       - [`Stored(stkey, srvkey, salt, iteration_count)]: get the
         pair (stkey, srvkey) with
         [stored_key h password salt iteration_count]
   *)

val create_server_session : 
      ?nonce:string ->
      profile -> (string -> credentials) -> server_session
  (** [create_server_session p auth]: Creates a new server session with
      profile [p] and authenticator function [auth].

      The function is [auth] is called when the credentials of the
      client have been received to check whether the client can be
      authenticated. It is called as

      {[
      let credentials = auth username
      ]}

      where [username] is the user name. The function can now raise
      [Not_found] if the user is unknown, or it can return the
      credentials. Note that the cleartext password needs not to
      be known. The credentials contain a salt and an iteration count:
      [salt] is a random string, and [iteration_count] a
      security parameter that should be at least 4096. Whereas [salt]
      should be different for each user, the [iteration_count] can be
      chosen as a constant (e.g. 4096). Now [salted_password] can be
      computed from the cleartext password and these two extra parameters.
      See [salt_password] below.
   *)

val create_server_session2 : 
      ?nonce:string ->
      profile -> (string -> string -> credentials) -> server_session
  (** Same as [create_server_session], but the authentication callback
      gets two arguments:

      {[
      let credentials = auth username authzname
      ]}

      where [authzname] is the passed authorization name (or "" if na).
   *)

val create_salt : unit -> string
  (** Creates a random string suited as salt *)

val salt_password :  Netsys_digests.iana_hash_fn -> 
                     string -> string -> int -> string
  (** [let salted_password = salt_password h password salt iteration_count]

      Use this now as credentials
      [`Salted_password(salted_password,salt,iteration_count)].

      As we do not implement [SASLprep] only passwords consisting of
      US-ASCII characters are accepted ([Invalid_encoding] otherwise).
   *)

val stored_key : Netsys_digests.iana_hash_fn -> 
                     string -> string -> int -> string * string

  (** [let stkey,srvkey = stored_key h password salt iteration_count]

      Use this now as credentials
      [`Stored_creds(stkey,srvkey,salt,iteration_count)].
   *)

val server_emit_flag : server_session -> bool
  (** Whether [server_emit_message] can now be called *)

val server_recv_flag : server_session -> bool
  (** Whether [server_recv_message] can now be called *)

val server_finish_flag : server_session -> bool
  (** Whether the client is authenticated *)

val server_error_flag : server_session -> bool
  (** Whether an error occurred, and the protocol cannot advance anymore *)

val server_emit_message : server_session -> string
  (** Emits the next message to be sent to the client *)

val server_emit_message_kv : server_session -> (string * string) list
  (** Emits the next message to be sent to the client. The message is returned
      as a list of key/value pairs.
   *)

val server_recv_message : server_session -> string -> unit
  (** Receives the next message from the client *)

val server_protocol_key : server_session -> string option
  (** The 128-bit protocol key for encrypting messages. This is available 
      as soon as the second client message has been received.
   *)

val server_channel_binding : server_session -> cb
  (** Returns the channel binding requirement. It is
      up to the application to enforce the binding. This information is 
      available as soon as the second client message has been received
   *)

val server_user_name : server_session -> string option
  (** The user name as transmitted from the client. This is returned here
      even before the authentication is completed!
   *)

val server_authz_name : server_session -> string option
  (** The authorization name as transmitted from the client. This is returned
      here
      even before the authentication is completed!
   *)

val server_export : server_session -> string
val server_import : string -> server_session
val server_import_any : string -> (string -> credentials) ->
                        server_session
val server_import_any2 : string -> (string -> string -> credentials) ->
                         server_session
  (** Exports a server session as string, and imports the string again.
      [server_import] can only import established sessions.
      [server_import_any] can also import unfinished sessions, but one needs
      to pass the authentication function as for [server_create_session].
      [server_import_any2] uses the modified auth function as in
      [server_create_session2].
   *)


val server_prop : server_session -> string -> string
  (** Returns a property of the client (or Not_found):
       - "snonce"
       - "cnonce"
       - "salt"
       - "i" (iteration_count)
       - "protocol_key"
   *)


(** {2 Confidentiality} *)

type specific_keys =
    { kc : string;
      ke : string;
      ki : string
    }
  (** The specific keys to use *)

(** This module implements AES in Ciphertext Stealing mode (see RFC 3962) *)
module AES_CTS : sig
  val c : int
  val m : int
  val encrypt : string -> string -> string
  val encrypt_mstrings : 
    string -> Netxdr_mstring.mstring list -> Netxdr_mstring.mstring list
  val decrypt : string -> string -> string
  val decrypt_mstrings : 
    string -> Netxdr_mstring.mstring list -> Netxdr_mstring.mstring list
  val tests : (string * string * string) list
  val run_tests : unit -> bool
  val run_mtests : unit -> bool
end


(** This is the cryptosystem as defined in RFC 3961, so far needed here.
    This uses [AES_CTS] as cipher, and SHA1-96 for signing.
 *)
module Cryptosystem : sig
  exception Integrity_error

  val derive_keys : string -> int -> specific_keys
    (** [derive_keys protocol_key usage]: Returns the specific keys for
	this [protocol_key] and this [usage] numbers. See RFC 4121 for
	applicable usage numbers
     *)

  val encrypt_and_sign :  specific_keys -> string -> string
    (** Encrypts the plaintext message and adds a signature to the
	ciphertext.

	Returns [ciphertext_with_signature].
     *)

  val encrypt_and_sign_mstrings : 
         specific_keys -> Netxdr_mstring.mstring list -> Netxdr_mstring.mstring list
    (** Same, but with data representation as [mstring list] *)

  val decrypt_and_verify :  specific_keys -> string -> string
    (** Decrypts the ciphertext and verifies the attached signature.
	Returns the restored plaintext. 

	For very short plaintexts (< 16 bytes) there will be some
	padding at the end ("residue"), as returned as [ec] above.
	We ignore this problem generally,
	because GSS-API adds a 16-byte header to the plaintext anyway,
	so these short messages do not occur.

	If the signature is not valid, the exception [Integrity_error]
	is raised.
     *)

  val decrypt_and_verify_mstrings :
         specific_keys -> Netxdr_mstring.mstring list -> Netxdr_mstring.mstring list
    (** Same, but with data representation as [mstring list] *)

  val get_ec : specific_keys -> int -> int
    (** [let ec = get_ec e_keys n]:
        Returns the required value for the "extra count" field of
	RFC 4121 if the plaintext message has size [n]. Here,
	[n] is the size of the payload message plus the token
	header of 16 bytes, i.e. the function is always called with
	[n >= 16].

	Here, the returned [ec] value is always 0.
     *)

  val get_mic : specific_keys -> string -> string
    (** Returns a message integrity code *)

  val get_mic_mstrings :
         specific_keys -> Netxdr_mstring.mstring list -> string
    (** Same, but with data representation as [mstring list] *)
end


module Debug : sig
  val enable : bool ref
    (** Enable debugging of this module *)
end
