Ticket #51516: patch-pextlib-curl_version_cmd.diff

src/pextlib1.0/curl.c

@@ -91 +91 @@
 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 +1436 @@
         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;
+
+        do {
+                curl_version_info_data *theVersionInfo = curl_version_info(CURLVERSION_NOW);
+                tcl_result = Tcl_NewListObj(0, NULL);
+                // info from the curl version we were built against:
+                Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewIntObj(CURLVERSION_NOW));
+                Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(LIBCURL_VERSION, -1));
+                // runtime info from the libcurl we are actually using:
+                Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(theVersionInfo->version, -1));
+                Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(theVersionInfo->host, -1));
+                Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(theVersionInfo->ssl_version, -1));
+                Tcl_SetObjResult(interp, tcl_result);
+        } while (0);
+
+        return theResult;
+}
+
 /**
  * curl command entry point.
  *
@@ -1454 +1484 @@
                 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 +1498 @@
         /* 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(
                                 interp,
                                 objv[1],
@@ -1479 +1505 @@
                                 "option",
                                 0,
                                 (int*) &theOptionIndex);
+        if (objc < 3 && theOptionIndex != kCurlVersion) {
+                Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+                return TCL_ERROR;
+        }
+
         if (theResult == TCL_OK) {
                 switch (theOptionIndex) {
                 case kCurlFetch:
@@ -1493 +1524 @@
                 case kCurlPost:
                         theResult = CurlPostCmd(interp, objc, objv);
                         break;
+                case kCurlVersion:
+                        theResult = CurlVersionCmd(interp, objc, objv);
+                        break;
                 }
         }