Add a curl version Tcl command to Pextlib.

This command can be useful for debugging connectivity issues  when
Pextlib becomes upgradeable via a dedicated port and uses a libcurl
that is also installed through its own dedicated port.

The command returns a Tcl dict containing information about the
libcurl version that Pextlib was built against as well as the
libcurl it is currently running against; a simplified equivalent
of `curl --version`.
Obtaining a list of names of available feature is possible only
since curl v7.87.0 so this information will probably be replaced
with a simple feature mask in the Pextlib build installed by the
MacPorts installer on most older Darwin versions.

See trac ticket #51516

src/pextlib1.0/curl.c

@@ -91,6 +91,7 @@ int CurlFetchCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]);
 int CurlIsNewerCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]);
 int CurlGetSizeCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]);
 int CurlPostCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]);
+int CurlVersionCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]);
 
 typedef struct {
 	Tcl_Interp *interp;
@@ -1435,6 +1436,61 @@ CurlPostCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[])
 	return theResult;
 }
 
+/**
+ * curl version subcommand entry point.
+ *
+ * @param interp		current interpreter
+ * @param objc			number of parameters
+ * @param objv			parameters
+ */
+int
+CurlVersionCmd(Tcl_Interp* interp, int objc, Tcl_Obj* const objv[])
+{
+	int theResult = TCL_OK;
+	Tcl_Obj *tcl_result = NULL;
+
+	curl_version_info_data *theVersionInfo = curl_version_info(CURLVERSION_NOW);
+	tcl_result = Tcl_NewDictObj();
+
+	// info from the curl version we were built against:
+	Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("VERSION_NOW-build", -1), Tcl_NewIntObj(CURLVERSION_NOW));
+	Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("VERSION-build", -1), Tcl_NewStringObj(LIBCURL_VERSION, -1));
+	// runtime info from the libcurl we are actually using:
+	Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("VERSION-runtime", -1), Tcl_NewStringObj(theVersionInfo->version, -1));
+	Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("HOST", -1), Tcl_NewStringObj(theVersionInfo->host, -1));
+	Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("SSL_BACKEND", -1), Tcl_NewStringObj(theVersionInfo->ssl_version, -1));
+	Tcl_Obj *tcl_prots = Tcl_NewListObj(0, NULL);
+	const char * const *prot = theVersionInfo->protocols;
+	while (*prot) {
+		Tcl_ListObjAppendElement(interp, tcl_prots, Tcl_NewStringObj(*prot, -1));
+		prot++;
+	}
+	Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("PROTOCOLS", -1), tcl_prots);
+// returning feature names requires a build-time and a runtime check:
+#if LIBCURL_VERSION_NUM >= 0x078700
+	if (theVersionInfo->age >= CURLVERSION_ELEVENTH && theVersionInfo->feature_names) {
+		Tcl_Obj *tcl_feats = Tcl_NewListObj(0, NULL);
+		const char * const *feats = theVersionInfo->feature_names;
+		while (*feats) {
+			Tcl_ListObjAppendElement(interp, tcl_feats, Tcl_NewStringObj(*feats, -1));
+			feats++;
+		}
+		Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("FEATURES", -1), tcl_feats);
+	} else
+#endif
+	{
+		// it would be possible to generate a list of feature names from the feature mask
+		// but tedious because it would involve checking for the existence of many of the 
+		// feature tokens; probably not justified for the intended use of the `curl version`
+		// command (primarily debugging).
+		Tcl_DictObjPut(interp, tcl_result, Tcl_NewStringObj("FEATURE_MASK", -1), Tcl_NewIntObj(theVersionInfo->features));
+	}
+
+	Tcl_SetObjResult(interp, tcl_result);
+
+	return theResult;
+}
+
 /**
  * curl command entry point.
  *
@@ -1454,11 +1510,12 @@ CurlCmd(
 		kCurlFetch,
 		kCurlIsNewer,
 		kCurlGetSize,
-		kCurlPost
+		kCurlPost,
+		kCurlVersion
 	} EOption;
 
 	static const char *options[] = {
-		"fetch", "isnewer", "getsize", "post", NULL
+		"fetch", "isnewer", "getsize", "post", "version", NULL
 	};
 	int theResult = TCL_OK;
 	EOption theOptionIndex;
@@ -1467,18 +1524,18 @@ CurlCmd(
 	/* TODO: use dispatch_once when we drop Leopard support */
 	pthread_once(&once, CurlInit);
 
-	if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
-		return TCL_ERROR;
-	}
-
-	theResult = Tcl_GetIndexFromObj(
+	theResult = objc > 1 ? Tcl_GetIndexFromObj(
 				interp,
 				objv[1],
 				options,
 				"option",
 				0,
-				(int*) &theOptionIndex);
+				(int*) &theOptionIndex) : TCL_ERROR;
+	if (theResult != TCL_OK || (objc < 3 && theOptionIndex != kCurlVersion)) {
+		Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+		return TCL_ERROR;
+	}
+
 	if (theResult == TCL_OK) {
 		switch (theOptionIndex) {
 		case kCurlFetch:
@@ -1493,6 +1550,9 @@ CurlCmd(
 		case kCurlPost:
 			theResult = CurlPostCmd(interp, objc, objv);
 			break;
+		case kCurlVersion:
+			theResult = CurlVersionCmd(interp, objc, objv);
+			break;
 		}
 	}