From a5e37ff17ed12dfee0a322f3542cb287022dba11 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 9 Jul 2018 17:11:36 +0200 Subject: [PATCH] Add CURLOPT_SSH_KNOWNHOSTS, CURLOPT_SSH_KEYFUNCTION --- curl-helper.c | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ curl.ml | 21 ++++++++++++++++ curl.mli | 18 ++++++++++++++ 3 files changed, 116 insertions(+) diff --git a/curl-helper.c b/curl-helper.c index 32b032e..14dbcc3 100644 --- a/curl-helper.c +++ b/curl-helper.c @@ -135,6 +135,7 @@ typedef enum OcamlValues Ocaml_CONNECT_TO, Ocaml_POSTREDIR, Ocaml_MIMEPOST, + Ocaml_SSH_KEYFUNCTION, /* Not used, last for size */ OcamlValuesSize @@ -1106,6 +1107,66 @@ static int cb_OPENSOCKETFUNCTION(void *data, } #endif +static int cb_SSH_KEYFUNCTION(CURL *easy, + const struct curl_khkey *knownkey, + const struct curl_khkey *foundkey, + enum curl_khmatch match, + void *clientp) +{ + caml_leave_blocking_section(); + + CAMLparam0(); + CAMLlocal4(known, found, mismatch, result); + Connection *conn = (Connection *)clientp; + int res = CURLKHSTAT_REJECT; + + switch (match) { + case CURLKHMATCH_OK: + found = ml_copy_string(foundkey->key, foundkey->len ? foundkey->len : strlen(foundkey->key)); + result = caml_callback2_exn(Field(conn->ocamlValues, Ocaml_SSH_KEYFUNCTION), Val_int(0), found); + break; + case CURLKHMATCH_MISMATCH: + found = ml_copy_string(foundkey->key, foundkey->len ? foundkey->len : strlen(foundkey->key)); + known = ml_copy_string(knownkey->key, knownkey->len ? knownkey->len : strlen(knownkey->key)); + mismatch = caml_alloc_small(1, 0); + Field(mismatch, 0) = found; + result = caml_callback2_exn(Field(conn->ocamlValues, Ocaml_SSH_KEYFUNCTION), mismatch, found); + break; + case CURLKHMATCH_MISSING: + found = ml_copy_string(foundkey->key, foundkey->len ? foundkey->len : strlen(foundkey->key)); + result = caml_callback2_exn(Field(conn->ocamlValues, Ocaml_SSH_KEYFUNCTION), Val_int(1), found); + break; + default: + caml_failwith("Invalid CURL_SSH_KEYFUNCTION argument"); + break; + } + + if (!Is_exception_result(result)) { + switch (Int_val(result)) { + case 0: + res = CURLKHSTAT_FINE_ADD_TO_FILE; + break; + case 1: + res = CURLKHSTAT_FINE; + break; + case 2: + res = CURLKHSTAT_REJECT; + break; + case 3: + res = CURLKHSTAT_DEFER; + break; + default: + caml_failwith("Invalid CURLOPT_SSH_KEYFUNCTION return value"); + break; + } + } + + CAMLdrop; + + caml_enter_blocking_section(); + return res; +} + /** ** curl_global_init helper function **/ @@ -1202,6 +1263,7 @@ SETOPT_FUNCTION( READ) SETOPT_FUNCTION( HEADER) SETOPT_FUNCTION( PROGRESS) SETOPT_FUNCTION( DEBUG) +SETOPT_FUNCTION( SSH_KEY) #if HAVE_DECL_CURLOPT_SEEKFUNCTION SETOPT_FUNCTION( SEEK) @@ -2785,6 +2847,19 @@ static void handle_POSTREDIR(Connection *conn, value option) } #endif +static void handle_SSH_KNOWNHOSTS(Connection *conn, value option) +{ + CAMLparam1(option); + CURLcode result = CURLE_OK; + + result = curl_easy_setopt(conn->handle, CURLOPT_SSH_KNOWNHOSTS, String_val(option)); + + if (result != CURLE_OK) + raiseError(conn, result); + + CAMLreturn0; +} + /** ** curl_easy_setopt helper function **/ @@ -3194,6 +3269,8 @@ CURLOptionMapping implementedOptionMap[] = #else MAP_NO(MIMEPOST), #endif + IMM(SSH_KNOWNHOSTS), + MAP(SSH_KEYFUNCTION), }; static Connection *duplicateConnection(Connection *original) diff --git a/curl.ml b/curl.ml index b408786..30ccffc 100644 --- a/curl.ml +++ b/curl.ml @@ -265,6 +265,17 @@ type curlMIMEPart = data: curlMIMEPartData; } +type curlKHMatch = + | CURLKHMATCH_OK + | CURLKHMATCH_MISMATCH of string + | CURLKHMATCH_MISSING + +type curlKHStat = + | CURLKHSTAT_FINE_ADD_TO_FILE + | CURLKHSTAT_FINE + | CURLKHSTAT_REJECT + | CURLKHSTAT_DEFER + (** Protocols to enable (via CURLOPT_PROTOCOLS and CURLOPT_REDIR_PROTOCOLS) *) type curlProto = | CURLPROTO_ALL (** enable everything *) @@ -445,6 +456,8 @@ type curlOption = | CURLOPT_CONNECT_TO of string list | CURLOPT_POSTREDIR of curlPostRedir list | CURLOPT_MIMEPOST of curlMIMEPart list + | CURLOPT_SSHKNOWNHOSTS of string + | CURLOPT_SSHKEYFUNCTION of (curlKHMatch -> string -> curlKHStat) type initOption = | CURLINIT_GLOBALALL @@ -970,6 +983,12 @@ let set_postredir conn l = let set_mimepost conn part = setopt conn (CURLOPT_MIMEPOST part) +let set_sshknownhosts conn s = + setopt conn (CURLOPT_SSHKNOWNHOSTS s) + +let set_sshkeyfunction conn f = + setopt conn (CURLOPT_SSHKEYFUNCTION f) + let get_effectiveurl conn = match (getinfo conn CURLINFO_EFFECTIVE_URL) with | CURLINFO_String s -> s @@ -1305,6 +1324,8 @@ class handle = method set_opensocketfunction closure = set_opensocketfunction conn closure method set_proxytype t = set_proxytype conn t method set_mimepost p = set_mimepost conn p + method set_sshknownhosts s = set_sshknownhosts conn s + method set_sshkeyfunction f = set_sshkeyfunction conn f method get_effectiveurl = get_effectiveurl conn method get_redirecturl = get_redirecturl conn diff --git a/curl.mli b/curl.mli index 0395d75..21b3fd7 100644 --- a/curl.mli +++ b/curl.mli @@ -273,6 +273,17 @@ type curlMIMEPart = data: curlMIMEPartData; } +type curlKHMatch = + | CURLKHMATCH_OK + | CURLKHMATCH_MISMATCH of string (* Base64-encoded *) + | CURLKHMATCH_MISSING + +type curlKHStat = + | CURLKHSTAT_FINE_ADD_TO_FILE + | CURLKHSTAT_FINE + | CURLKHSTAT_REJECT + | CURLKHSTAT_DEFER + (** Protocols to enable (via CURLOPT_PROTOCOLS and CURLOPT_REDIR_PROTOCOLS) *) type curlProto = | CURLPROTO_ALL (** enable everything *) @@ -453,6 +464,8 @@ type curlOption = | CURLOPT_CONNECT_TO of string list | CURLOPT_POSTREDIR of curlPostRedir list | CURLOPT_MIMEPOST of curlMIMEPart list (* @since libcurl 7.56.0 *) + | CURLOPT_SSHKNOWNHOSTS of string + | CURLOPT_SSHKEYFUNCTION of (curlKHMatch -> string (* raw *) -> curlKHStat) type initOption = | CURLINIT_GLOBALALL @@ -717,6 +730,9 @@ val set_postredir : t -> curlPostRedir list -> unit val set_mimepost : t -> curlMIMEPart list -> unit (** @since 0.8.2 *) +val set_sshknownhosts : t -> string -> unit +val set_sshkeyfunction : t -> (curlKHMatch -> string -> curlKHStat) -> unit + (** {2 Get transfer properties} *) val get_effectiveurl : t -> string @@ -903,6 +919,8 @@ class handle : method set_resolve : (string * int * string) list -> (string * int) list -> unit method set_dns_servers : string list -> unit method set_mimepost : curlMIMEPart list -> unit + method set_sshknownhosts : string -> unit + method set_sshkeyfunction : (curlKHMatch -> string -> curlKHStat) -> unit method get_effectiveurl : string method get_redirecturl : string -- 2.11.4.GIT