Tcl Library Source Code

View Ticket
Login
Ticket UUID: 8fd2561785f5dcc7f7c88182c89812a0a27a4498
Title: Fix oauth::query defaulting POST requests to GET
Type: Patch Version: tcllib/1.18 oauth/1
Submitter: anonymous Created on: 2017-01-15 21:09:25
Subsystem: oauth Assigned To: aku
Priority: 7 High Severity: Severe
Status: Closed Last Modified: 2019-04-16 23:31:12
Resolution: Fixed Closed By: aku
    Closed on: 2018-01-24 20:42:49
Description:
--- oauth_orig.tcl      2017-01-15 21:05:40.614045465 +0000
+++ oauth.tcl   2017-01-15 23:39:27.259547226 +0000
@@ -1,4 +1,4 @@
-# !/bin/sh
+# !/bin/sh
 # the next line will restart with tclsh wherever it is \
 exec tclsh "$0" "$@"
 
@@ -156,22 +156,25 @@
     lappend paramList "oauth_token=$oauth(-accesstoken)"
     lappend paramList "oauth_version=$oauth(-oauthversion)"
     
+    set header $paramList
+    
     if {$postQuery eq {}} {
        set url [lindex [split $baseURL {?}] 0]
        set queryString [lindex [split $baseURL {?}] 1]
-       foreach argument [split $queryString {&}] {
-           lappend paramList $argument
-       }
        set httpMethod {GET}
     } else {
        set url $baseURL
+       set queryString $postQuery                                                                                                                                        
        set httpMethod {POST}                                                                                                                                             
     }                                                                                                                                                                    
+    foreach argument [split $queryString {&}] {                                                                                                                          
+        lappend paramList $argument                                                                                                                                      
+    }                                                                                                                                                                    
                                                                                                                                                                          
-    foreach parameter $paramList {                                                                                                                                       
+    foreach parameter $header {                                                                                                                                          
        set key [lindex [split $parameter {=}] 0]                                                                                                                         
        set value [join [lrange [split $parameter {=}] 1 end] {=}]                                                                                                        
-       lappend header "${key}=\"${value}\""                                                                                                                              
+       lappend header2 "${key}=\"${value}\""                                                                                                                             
     }                                                                                                                                                                    
     set paramString [join [lsort -dictionary $paramList] {&}]                                                                                                            
                                                                                                                                                                          
@@ -183,7 +186,7 @@                                                                                                                                                       
     set signKey "[PercentEncode $oauth(-consumersecret)]&[PercentEncode $oauth(-accesstokensecret)]"                                                                     
     set signature [base64::encode [sha1::hmac -bin -key $signKey $signString]]

-    lappend header "oauth_signature=\"[PercentEncode $signature]\""
+    lappend header2 "oauth_signature=\"[PercentEncode $signature]\""
     if {$oauth(-debug) == 1} {
        puts {oauth::header: Authorization Oauth}
        foreach line $header {
@@ -191,7 +194,7 @@
        }
        puts "\nBaseString: $signString"
     }
-    return "Authorization [list [concat OAuth [join [lsort -dictionary $header] {, }]]]"
+    return "Authorization [list [concat OAuth [join [lsort -dictionary $header2] {, }]]]"
 }

 # query --
@@ -200,7 +203,7 @@
 # Arguments:
 #       baseURL     api host URL with ?arguments if it's a GET request
 #       postQuery   POST query if it's a POST query
-# Result:
+# Result:
 #       The result will be list with 2 arguments.
 #       The first argument is an array with the http's header
 #       and the second one is JSON data received from the server. The header is
@@ -235,6 +238,7 @@
     } else {
        set url $baseURL
        set httpMethod {POST}
+       set queryString $postQuery
     }

     if {$httpMethod eq {GET}} {
@@ -246,13 +250,11 @@
        set requestBody $queryString
     }
     if {$queryString ne {}} {
-       set headerURL ${url}?${queryString}
+       set header [header $url $queryString]
     } else {
-       set headerURL $url
+       set header [header $url]
     }

-    set header [header $headerURL]
-
     http::config \
        -proxyhost $oauth(-proxyhost) \
        -proxyport $oauth(-proxyport) \
User Comments: aku added on 2019-04-16 23:30:05:

Unclear how I missed the May 5, 2018 response. Deep apologies.

Finally done the removal of the bogus \{ sequence.

Looked over things a few times and I am wholly unclear why it was written with it. My best guess this late is that it was an accidental insertion I then missed, and then not thought about on the first "fix" (See [aec286d43d]).

Done with with commit [a136e80afe].

Version bump to 1.0.3.

Thank you for your patience here. Hopefully this now truly done.


chrstphrchvz added on 2019-03-05 15:21:18:

There was an issue opened on the GitHub mirror a few years ago that I'm wondering might have been for this same issue this ticket addresses: https://github.com/tcltk/tcllib/issues/7. Can anyone confirm?

(Note that issue trackers on GitHub repositories can be disabled.)


anonymous added on 2018-05-20 00:29:08:

OK, can you explain to me how adding a brace in front of an otherwise fine regular expression is supposed to work? I'm not sure what you're trying to accomplish here. My scripts don't work when there is a { in front of a new-line capturing expression. I suggest deleting the \{ sequence entirely.


aku added on 2018-05-18 17:48:41:
Fixed with commit [aec286d43d].

aku added on 2018-05-17 20:09:07:
Dang.

anonymous added on 2018-05-15 16:32:23:

Also, in line 275 in ::oauth::QuoteValues the variable header does not exist and should be $params, otherwise it causes a runtime error.


anonymous added on 2018-05-15 06:46:57:
This change introduced an opening brace in the regexp in line 286 in ::oauth::Split, which prevents the package from loading.

aku added on 2018-01-24 20:42:49:

Nothing heard back. Accepted as working.

Merged into `trunk` and `tcllib-1-19-rc`.

Relevant merge commits:

  • [738baecbc3] = `trunk`
  • [52bd859b74] = `tcllib-1-19-rc`


aku added on 2017-05-29 21:03:41:

While I still had to apply it manually (*) with the context of an unidiff it was now at least possible.

Did some additional cleanup and simplification (Moved common code to helper procs, use of 8.5 lassign, use of 8.5 {*}). Bumped to version 1.0.1.

See commit [a0ec57b1bd].

Not merged yet. As I do not have testsuite to run I would like you to test the change and give your approval (or not).

(Ad *) Copying the patch out of the description seems to break something in the formatting. For the future please consider to attach the patch instead of placing it in the description. When you have the ticket view open this is the left-most button in the secondary navbar.


aku added on 2017-05-29 19:15:02:
Thank you. That looks much more readable now.

aku added on 2017-05-29 17:38:49:

I am sorry, I am unable to apply this patch.

Using the patch command patch oauth.tcl PATCH I get

  patching file oauth.tcl
  Reversed (or previously applied) patch detected!  Assume -R? [n] y
  Hunk #2 FAILED at 168.
  Hunk #3 FAILED at 171.
  Hunk #4 FAILED at 242.
  Hunk #5 FAILED at 254.
  Hunk #6 FAILED at 256.
  patch: **** '<' expected at line 22 of patch

Please provide me with a unified diff (the result of a diff -u ...). This is a more readable form I can also apply manually if needed.