--- /dev/null
+John Benediktsson
--- /dev/null
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: assocs hashtables help.syntax help.markup io strings ;
+
+IN: ini-file
+
+HELP: read-ini
+{ $values { "assoc" assoc } }
+{ $description
+ "Reads and parses an INI configuration from the " { $link input-stream }
+ " and returns the result as a nested " { $link hashtable }
+ "."
+} ;
+
+HELP: write-ini
+{ $values { "assoc" assoc } }
+{ $description
+ "Writes a configuration to the " { $link output-stream }
+ " in the INI format."
+} ;
+
+HELP: string>ini
+{ $values { "str" string } { "assoc" assoc } }
+{ $description
+ "Parses the specified " { $link string } " as an INI configuration"
+ " and returns the result as a nested " { $link hashtable }
+ "."
+} ;
+
+HELP: ini>string
+{ $values { "assoc" assoc } { "str" string } }
+{ $description
+ "Encodes the specified " { $link hashtable } " as an INI configuration."
+} ;
--- /dev/null
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: ini-file tools.test ;
+
+{ H{ } } [ "" string>ini ] unit-test
+
+{ H{ { "section" H{ } } } } [ "[section]" string>ini ] unit-test
+
+{ H{ { "section" H{ } } } } [ "[\"section\" ]" string>ini ] unit-test
+
+{ H{ { " some name with spaces " H{ } } } }
+[ "[ \" some name with spaces \"]" string>ini ] unit-test
+
+{ H{ { "[]" H{ } } } } [ "[\\[\\]]" string>ini ] unit-test
+
+{ H{ { "foo" "bar" } } } [ "foo=bar" string>ini ] unit-test
+
+{ H{ { "foo" "bar" } { "baz" "quz" } } }
+[ "foo=bar\nbaz= quz" string>ini ] unit-test
+
+{ H{ { "section" H{ { "foo" "abc def" } } } } }
+[
+ "
+ [section]
+ foo = abc def
+ " string>ini
+] unit-test
+
+{ H{ { "section" H{ { "foo" "abc def" } } } } }
+[
+ "
+ [section]
+ foo = abc \\
+ \"def\"
+ " string>ini
+] unit-test
+
+{ H{ { "section" H{ { "foo" "abc def" } } } } }
+[
+ "
+ [section]
+ foo = \"abc \" \\
+ def
+ " string>ini
+] unit-test
+
+{ H{ { "section" H{ { "foo" "abc def" } } } } }
+[
+ "
+ [section] foo = \"abc def\"
+ " string>ini
+] unit-test
+
+{ H{ { "section" H{ { "foo" "abc def" } } } } }
+[
+ "
+ [section] foo = abc \\
+ \"def\"
+ " string>ini
+] unit-test
+
+{ H{ { "section" H{ { "foo" "" } } } } }
+[
+ "
+ [section]
+ foo=
+ " string>ini
+] unit-test
+
+{ H{ { "section" H{ { "foo" "" } } } } }
+[
+ "
+ [section]
+ foo
+ " string>ini
+] unit-test
+
+{ H{ { "" H{ { "" "" } } } } }
+[
+ "
+ []
+ =
+ " string>ini
+] unit-test
+
+{ H{ { "owner" H{ { "name" "John Doe" }
+ { "organization" "Acme Widgets Inc." } } }
+ { "database" H{ { "server" "192.0.2.62" }
+ { "port" "143" }
+ { "file" "payroll.dat" } } } } }
+[
+ "
+ ; last modified 1 April 2001 by John Doe
+ [owner]
+ name=John Doe
+ organization=Acme Widgets Inc.
+
+ [database]
+ server=192.0.2.62 ; use IP address in case network name resolution is not working
+ port=143
+ file = \"payroll.dat\"
+ " string>ini
+] unit-test
+
+{ H{ { "a long section name"
+ H{ { "a long key name" "a long value name" } } } } }
+[
+ "
+ [a long section name ]
+ a long key name= a long value name
+ " string>ini
+] unit-test
+
+{ H{ { "key with \n esc\ape \r codes \""
+ "value with \t esc\ape codes" } } }
+[
+ "
+ key with \\n esc\\ape \\r codes \\\" = value with \\t esc\\ape codes
+ " string>ini
+] unit-test
+
+
+{ "key with \\n esc\\ape \\r codes \\\"=value with \\t esc\\ape codes\n" }
+[
+ H{ { "key with \n esc\ape \r codes \""
+ "value with \t esc\ape codes" } } ini>string
+] unit-test
--- /dev/null
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: arrays assocs combinators combinators.short-circuit
+formatting hashtables io io.streams.string kernel make math
+namespaces quoting sequences splitting strings strings.parser ;
+
+IN: ini-file
+
+<PRIVATE
+
+: escape ( ch -- ch' )
+ H{
+ { CHAR: a CHAR: \a }
+ { CHAR: b CHAR: \b }
+ { CHAR: f CHAR: \f }
+ { CHAR: n CHAR: \n }
+ { CHAR: r CHAR: \r }
+ { CHAR: t CHAR: \t }
+ { CHAR: v CHAR: \v }
+ { CHAR: ' CHAR: ' }
+ { CHAR: \" CHAR: \" }
+ { CHAR: \\ CHAR: \\ }
+ { CHAR: ? CHAR: ? }
+ { CHAR: ; CHAR: ; }
+ { CHAR: [ CHAR: [ }
+ { CHAR: ] CHAR: ] }
+ { CHAR: = CHAR: = }
+ } ?at [ bad-escape ] unless ;
+
+: (unescape-string) ( str -- )
+ CHAR: \\ over index [
+ cut-slice [ % ] dip rest-slice
+ dup empty? [ "Missing escape code" throw ] when
+ unclip-slice escape , (unescape-string)
+ ] [ % ] if* ;
+
+: unescape-string ( str -- str' )
+ [ (unescape-string) ] "" make ;
+
+: escape-string ( str -- str' )
+ [
+ [
+ H{
+ { CHAR: \a "\\a" }
+ { CHAR: \b "\\b" }
+ { CHAR: \f "\\f" }
+ { CHAR: \n "\\n" }
+ { CHAR: \r "\\r" }
+ { CHAR: \t "\\t" }
+ { CHAR: \b "\\v" }
+ { CHAR: ' "\\'" }
+ { CHAR: \" "\\\"" }
+ { CHAR: \\ "\\\\" }
+ { CHAR: ? "\\?" }
+ { CHAR: ; "\\;" }
+ { CHAR: [ "\\[" }
+ { CHAR: ] "\\]" }
+ { CHAR: = "\\=" }
+ } ?at [ % ] [ , ] if
+ ] each
+ ] "" make ;
+
+: space? ( ch -- ? )
+ "\s\t\n\r\f\v" member-eq? ;
+
+: unspace ( str -- str' )
+ [ space? ] trim ;
+
+: unwrap ( str -- str' )
+ 1 swap [ length 1 - ] keep subseq ;
+
+: uncomment ( str -- str' )
+ ";#" [ over index [ head ] when* ] each ;
+
+: cleanup-string ( str -- str' )
+ unspace unquote unescape-string ;
+
+SYMBOL: section
+SYMBOL: option
+
+: section? ( line -- index/f )
+ {
+ [ length 1 > ]
+ [ first CHAR: [ = ]
+ [ CHAR: ] swap last-index ]
+ } 1&& ;
+
+: line-continues? ( line -- ? )
+ ?last CHAR: \ = ;
+
+: section, ( -- )
+ section get [ , ] when* ;
+
+: option, ( name value -- )
+ section get [ second swapd set-at ] [ 2array , ] if* ;
+
+: [section] ( line -- )
+ unwrap cleanup-string H{ } clone 2array section set ;
+
+: name=value ( line -- )
+ option [
+ [ swap [ first2 ] dip ] [
+ "=" split1 [ cleanup-string "" ] [ "" or ] bi*
+ ] if*
+ dup line-continues? [
+ dup length 1 - head cleanup-string
+ dup last space? [ " " append ] unless append 2array
+ ] [
+ cleanup-string append option, f
+ ] if
+ ] change ;
+
+: parse-line ( line -- )
+ uncomment unspace dup section? [
+ section, 1 + cut [ [section] ] [ unspace ] bi*
+ ] when* [ name=value ] unless-empty ;
+
+PRIVATE>
+
+: read-ini ( -- assoc )
+ section off option off
+ [ [ parse-line ] each-line section, ] { } make
+ >hashtable ;
+
+: write-ini ( assoc -- )
+ [
+ dup string? [
+ [ escape-string ] bi@ "%s=%s\n" printf
+ ] [
+ [ escape-string "[%s]\n" printf ] dip
+ [ [ escape-string ] bi@ "%s=%s\n" printf ]
+ assoc-each nl
+ ] if
+ ] assoc-each ;
+
+! FIXME: escaped comments "\;" don't work
+
+: string>ini ( str -- assoc )
+ [ read-ini ] with-string-reader ;
+
+: ini>string ( assoc -- str )
+ [ write-ini ] with-string-writer ;
--- /dev/null
+Parses INI configuration files.
--- /dev/null
+parsing
+file formats
--- /dev/null
+Slava Pestov
--- /dev/null
+USING: oauth1 oauth1.private tools.test accessors kernel assocs
+strings namespaces urls ;
+
+{ "%26&b" } [ "&" "b" hmac-key ] unit-test
+{ "%26&" } [ "&" f hmac-key ] unit-test
+
+{ "B&http%3A%2F%2Ftwitter.com%2F&a%3Db" } [
+ URL" http://twitter.com"
+ "B"
+ { { "a" "b" } }
+ signature-base-string
+] unit-test
+
+{ "0EieqbHx0FJ/RtFskmRj9/TDpqo=" } [
+ "ABC" "DEF" <token> consumer-token set
+
+ URL" http://twitter.com"
+ <request-token-params>
+ 12345 >>timestamp
+ 54321 >>nonce
+ <request-token-request>
+ post-data>>
+ "oauth_signature" of
+ >string
+] unit-test
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs base64 calendar checksums.hmac
+checksums.sha combinators fry http http.client kernel locals
+make math math.parser namespaces present random sequences
+sorting strings urls urls.encoding urls.private ;
+IN: oauth1
+
+SYMBOL: consumer-token
+
+TUPLE: token key secret user-data ;
+
+: <token> ( key secret -- token )
+ token new
+ swap >>secret
+ swap >>key ;
+
+<PRIVATE
+
+TUPLE: token-params
+consumer-token
+timestamp
+nonce ;
+
+: new-token-params ( class -- params )
+ new
+ consumer-token get >>consumer-token
+ now timestamp>unix-time >integer >>timestamp
+ 16 random-bytes bytes>hex-string >>nonce ; inline
+
+: present-base-url ( url -- string )
+ [
+ [ unparse-protocol ]
+ [ unparse-authority ]
+ [ path>> url-encode % ] tri
+ ] "" make ;
+
+:: signature-base-string ( url request-method params -- string )
+ [
+ request-method % "&" %
+ url present-base-url url-encode-full % "&" %
+ params assoc>query url-encode-full %
+ url query>> [ assoc>query "&" prepend url-encode-full % ] when*
+ ] "" make ;
+
+: hmac-key ( consumer-secret token-secret -- key )
+ [ url-encode-full ] [ "" or url-encode-full ] bi* "&" glue ;
+
+: make-token-params ( params quot -- assoc )
+ '[
+ "1.0" "oauth_version" ,,
+ "HMAC-SHA1" "oauth_signature_method" ,,
+
+ _
+ [
+ [ consumer-token>> key>> "oauth_consumer_key" ,, ]
+ [ timestamp>> "oauth_timestamp" ,, ]
+ [ nonce>> "oauth_nonce" ,, ]
+ tri
+ ] bi
+ ] H{ } make ; inline
+
+:: sign-params ( url request-method consumer-token request-token params -- signed-params )
+ params sort-keys :> params
+ url request-method params signature-base-string :> sbs
+ consumer-token secret>> request-token dup [ secret>> ] when hmac-key :> key
+ sbs key sha1 hmac-bytes >base64 >string :> signature
+ params { "oauth_signature" signature } prefix ;
+
+: extract-user-data ( assoc -- assoc' )
+ [
+ drop
+ { "oauth_token" "oauth_token_secret" } member? not
+ ] assoc-filter ;
+
+: parse-token ( response data -- token )
+ nip
+ query>assoc
+ [ [ "oauth_token" ] dip at ]
+ [ [ "oauth_token_secret" ] dip at ]
+ [ extract-user-data ]
+ tri
+ [ <token> ] dip >>user-data ;
+
+PRIVATE>
+
+TUPLE: request-token-params < token-params
+{ callback-url initial: "oob" } ;
+
+: <request-token-params> ( -- params )
+ request-token-params new-token-params ;
+
+<PRIVATE
+
+:: <token-request> ( url consumer-token request-token params -- request )
+ url "POST" consumer-token request-token params sign-params
+ url
+ <post-request> ;
+
+: make-request-token-params ( params -- assoc )
+ [ callback-url>> "oauth_callback" ,, ] make-token-params ;
+
+: <request-token-request> ( url params -- request )
+ [ consumer-token>> f ] [ make-request-token-params ] bi
+ <token-request> ;
+
+PRIVATE>
+
+: obtain-request-token ( url params -- token )
+ <request-token-request> http-request parse-token ;
+
+TUPLE: access-token-params < token-params request-token verifier ;
+
+: <access-token-params> ( -- params )
+ access-token-params new-token-params ;
+
+<PRIVATE
+
+: make-access-token-params ( params -- assoc )
+ [
+ [ request-token>> key>> "oauth_token" ,, ]
+ [ verifier>> "oauth_verifier" ,, ]
+ bi
+ ] make-token-params ;
+
+: <access-token-request> ( url params -- request )
+ [ consumer-token>> ]
+ [ request-token>> ]
+ [ make-access-token-params ] tri
+ <token-request> ;
+
+PRIVATE>
+
+: obtain-access-token ( url params -- token )
+ <access-token-request> http-request parse-token ;
+
+SYMBOL: access-token
+
+TUPLE: oauth-request-params < token-params access-token ;
+
+: <oauth-request-params> ( -- params )
+ oauth-request-params new-token-params
+ access-token get >>access-token ;
+
+<PRIVATE
+
+:: signed-oauth-request-params ( request params -- params )
+ request url>>
+ request method>>
+ params consumer-token>>
+ params access-token>>
+ params
+ [
+ access-token>> key>> "oauth_token" ,,
+ request post-data>> %%
+ ] make-token-params
+ sign-params ;
+
+: build-auth-string ( params -- string )
+ [ [ present url-encode-full ] bi@ "\"" "\"" surround "=" glue ] { } assoc>map
+ ", " join "OAuth realm=\"\", " prepend ;
+
+PRIVATE>
+
+: set-oauth ( request params -- request )
+ dupd signed-oauth-request-params build-auth-string
+ "Authorization" set-header ;
--- /dev/null
+web
+network
--- /dev/null
+Björn Lindqvist
--- /dev/null
+! Copyright (C) 2018 Björn Lindqvist.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: oauth2
+
+ARTICLE: "oauth2" "Oauth2 Support"
+"The " { $vocab-link "oauth2" } " vocab implements client support for the Oauth2 protocol."
+$nl
+"To use the oauth2 vocab, first create an instance of the " { $link oauth2 } " class to represent the Oauth2 provider's settings. The slots 'auth-uri' and 'token-uri' should be set to the providers authentication and token uri:ss. The 'redirect-uri' should hold the URI to a callback URL, which usually must be registered with the provider. The 'client-id' and 'client-secret' slots identifies the application and should be kept secret. For example, to initialize an oauth2 instance compatible with GitHub's api use:"
+{ $unchecked-example
+ "\"https://github.com/login/oauth/authorize\""
+ "\"https://github.com/login/oauth/access_token\""
+ "\"https://localhost:8080\" \"client-id\" \"client-secret\""
+ "\"user\" { } oauth2 boa"
+}
+"Then to get hold of an access token, use the " { $link console-flow } " word and enter the verification code given by the provider. This puts a " { $link tokens } " instance on the stack whose slot 'access' contains the actual access token. It can be used to make API calls on behalf of the user. For example, to list all the user's GitHub repositories:"
+{ $unchecked-example
+ "\"https://api.github.com/user/repos\" \"access-token\""
+ "oauth-http-get"
+}
+"Some providers limit the validity of the access token. If so, the provider sets the 'expiry' slot on the " { $link tokens } " tuple to the tokens expiration date and 'refresh' to a refresh token. The refresh token can be used with the " { $link refresh-flow } " word to request new access tokens from the provider."
+{ $notes "The vocab only implements the console flow, but other methods for acquiring tokens could be added in the future" } ;
+
+ABOUT: "oauth2"
--- /dev/null
+USING: accessors calendar kernel oauth2 tools.test urls ;
+
+! assoc>tokens
+{
+ "blah" "bleh" t
+} [
+ H{
+ { "expires_in" 3600 }
+ { "access_token" "blah" }
+ { "token_type" "Bearer" }
+ { "refresh_token" "bleh" }
+ } assoc>tokens
+ [ access>> ] [ refresh>> ] [ expiry>> timestamp? ] tri
+] unit-test
+
+! oauth2>auth-uri
+{
+ URL" https://github.com/login/oauth/authorize?client_id=1234&scope=user&redirect_uri=test-pest&state=abcd&response_type=code&access_type=offline"
+} [
+ "https://github.com/login/oauth/authorize"
+ "https://github.com/login/oauth/access_token"
+ "test-pest"
+ "1234" "password" "user"
+ { { "state" "abcd" } } oauth2 boa oauth2>auth-uri
+] unit-test
+
+! tokens-params
+{
+ {
+ { "code" "hej" }
+ { "client_id" "1234" }
+ { "client_secret" "password" }
+ { "redirect_uri" "test-pest" }
+ { "state" "abcd" }
+ { "grant_type" "authorization_code" }
+ }
+} [
+ "https://github.com/login/oauth/authorize"
+ "https://github.com/login/oauth/access_token"
+ "test-pest"
+ "1234" "password" "user" { { "state" "abcd" } } oauth2 boa
+ "hej" tokens-params
+] unit-test
--- /dev/null
+! Copyright (C) 2016 Björn Lindqvist.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar combinators http.client io
+json.reader kernel make math.order sequences unicode urls
+webbrowser ;
+IN: oauth2
+
+: console-prompt ( query -- str/f )
+ write flush readln [ blank? ] trim [ f ] when-empty ;
+
+: post-json-request ( params token-uri -- assoc )
+ <post-request> dup header>> "application/json" "Accept" rot set-at
+ http-request nip json> ;
+
+TUPLE: tokens access refresh expiry ;
+
+: assoc>expiry ( json -- expiry )
+ "expires_in" of [ seconds now time+ ] [ f ] if* ;
+
+: assoc>tokens ( json -- tokens )
+ [ "access_token" of ]
+ [ "refresh_token" of ]
+ [ assoc>expiry ] tri tokens boa ;
+
+: access-expired? ( tokens -- ? )
+ expiry>> [ now before? ] [ f ] if* ;
+
+: update-tokens ( tokens1 tokens2 -- tokens1 )
+ 2dup expiry>> >>expiry drop access>> >>access ;
+
+TUPLE: oauth2
+ auth-uri
+ token-uri
+ redirect-uri
+ client-id
+ client-secret
+ scope
+ extra-params ;
+
+: tokens-params ( oauth2 code -- params )
+ [
+ "code" ,,
+ {
+ [ client-id>> "client_id" ,, ]
+ [ client-secret>> "client_secret" ,, ]
+ [ redirect-uri>> "redirect_uri" ,, ]
+ [ extra-params>> %% ]
+ } cleave
+ "authorization_code" "grant_type" ,,
+ ] { } make ;
+
+: refresh-params ( oauth2 refresh -- params )
+ [
+ "refresh_token" ,,
+ [ client-id>> "client_id" ,, ]
+ [ client-secret>> "client_secret" ,, ]
+ [ extra-params>> %% ] tri
+ "refresh_token" "grant_type" ,,
+ ] { } make ;
+
+: auth-params ( oauth2 -- params )
+ [
+ {
+ [ client-id>> "client_id" ,, ]
+ [ scope>> "scope" ,, ]
+ [ redirect-uri>> "redirect_uri" ,, ]
+ [ extra-params>> %% ]
+ } cleave
+ "code" "response_type" ,,
+ "offline" "access_type" ,,
+ ] { } make ;
+
+: oauth2>auth-uri ( oauth2 -- uri )
+ [ auth-uri>> >url ] [ auth-params ] bi set-query-params ;
+
+! Other flows can be useful to support too.
+: console-flow ( oauth2 -- tokens/f )
+ dup oauth2>auth-uri open-url
+ "Enter verification code: " console-prompt
+ [
+ dupd tokens-params swap token-uri>> post-json-request
+ assoc>tokens
+ ] [ drop f ] if* ;
+
+: refresh-flow ( oauth2 tokens -- tokens' )
+ dupd refresh>> refresh-params swap token-uri>> post-json-request
+ assoc>tokens ;
+
+! Using the token to access secured resources.
+: add-token ( request url -- )
+ "Bearer " prepend "Authorization" rot header>> set-at ;
+
+: oauth-http-get ( url access-token -- response data )
+ [ <get-request> dup ] dip add-token http-request ;
--- /dev/null
+web
+network
+++ /dev/null
-John Benediktsson
+++ /dev/null
-! Copyright (C) 2010 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
-
-USING: assocs hashtables help.syntax help.markup io strings ;
-
-IN: ini-file
-
-HELP: read-ini
-{ $values { "assoc" assoc } }
-{ $description
- "Reads and parses an INI configuration from the " { $link input-stream }
- " and returns the result as a nested " { $link hashtable }
- "."
-} ;
-
-HELP: write-ini
-{ $values { "assoc" assoc } }
-{ $description
- "Writes a configuration to the " { $link output-stream }
- " in the INI format."
-} ;
-
-HELP: string>ini
-{ $values { "str" string } { "assoc" assoc } }
-{ $description
- "Parses the specified " { $link string } " as an INI configuration"
- " and returns the result as a nested " { $link hashtable }
- "."
-} ;
-
-HELP: ini>string
-{ $values { "assoc" assoc } { "str" string } }
-{ $description
- "Encodes the specified " { $link hashtable } " as an INI configuration."
-} ;
+++ /dev/null
-! Copyright (C) 2010 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
-
-USING: ini-file tools.test ;
-
-{ H{ } } [ "" string>ini ] unit-test
-
-{ H{ { "section" H{ } } } } [ "[section]" string>ini ] unit-test
-
-{ H{ { "section" H{ } } } } [ "[\"section\" ]" string>ini ] unit-test
-
-{ H{ { " some name with spaces " H{ } } } }
-[ "[ \" some name with spaces \"]" string>ini ] unit-test
-
-{ H{ { "[]" H{ } } } } [ "[\\[\\]]" string>ini ] unit-test
-
-{ H{ { "foo" "bar" } } } [ "foo=bar" string>ini ] unit-test
-
-{ H{ { "foo" "bar" } { "baz" "quz" } } }
-[ "foo=bar\nbaz= quz" string>ini ] unit-test
-
-{ H{ { "section" H{ { "foo" "abc def" } } } } }
-[
- "
- [section]
- foo = abc def
- " string>ini
-] unit-test
-
-{ H{ { "section" H{ { "foo" "abc def" } } } } }
-[
- "
- [section]
- foo = abc \\
- \"def\"
- " string>ini
-] unit-test
-
-{ H{ { "section" H{ { "foo" "abc def" } } } } }
-[
- "
- [section]
- foo = \"abc \" \\
- def
- " string>ini
-] unit-test
-
-{ H{ { "section" H{ { "foo" "abc def" } } } } }
-[
- "
- [section] foo = \"abc def\"
- " string>ini
-] unit-test
-
-{ H{ { "section" H{ { "foo" "abc def" } } } } }
-[
- "
- [section] foo = abc \\
- \"def\"
- " string>ini
-] unit-test
-
-{ H{ { "section" H{ { "foo" "" } } } } }
-[
- "
- [section]
- foo=
- " string>ini
-] unit-test
-
-{ H{ { "section" H{ { "foo" "" } } } } }
-[
- "
- [section]
- foo
- " string>ini
-] unit-test
-
-{ H{ { "" H{ { "" "" } } } } }
-[
- "
- []
- =
- " string>ini
-] unit-test
-
-{ H{ { "owner" H{ { "name" "John Doe" }
- { "organization" "Acme Widgets Inc." } } }
- { "database" H{ { "server" "192.0.2.62" }
- { "port" "143" }
- { "file" "payroll.dat" } } } } }
-[
- "
- ; last modified 1 April 2001 by John Doe
- [owner]
- name=John Doe
- organization=Acme Widgets Inc.
-
- [database]
- server=192.0.2.62 ; use IP address in case network name resolution is not working
- port=143
- file = \"payroll.dat\"
- " string>ini
-] unit-test
-
-{ H{ { "a long section name"
- H{ { "a long key name" "a long value name" } } } } }
-[
- "
- [a long section name ]
- a long key name= a long value name
- " string>ini
-] unit-test
-
-{ H{ { "key with \n esc\ape \r codes \""
- "value with \t esc\ape codes" } } }
-[
- "
- key with \\n esc\\ape \\r codes \\\" = value with \\t esc\\ape codes
- " string>ini
-] unit-test
-
-
-{ "key with \\n esc\\ape \\r codes \\\"=value with \\t esc\\ape codes\n" }
-[
- H{ { "key with \n esc\ape \r codes \""
- "value with \t esc\ape codes" } } ini>string
-] unit-test
+++ /dev/null
-! Copyright (C) 2010 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
-
-USING: arrays assocs combinators combinators.short-circuit
-formatting hashtables io io.streams.string kernel make math
-namespaces quoting sequences splitting strings strings.parser ;
-
-IN: ini-file
-
-<PRIVATE
-
-: escape ( ch -- ch' )
- H{
- { CHAR: a CHAR: \a }
- { CHAR: b CHAR: \b }
- { CHAR: f CHAR: \f }
- { CHAR: n CHAR: \n }
- { CHAR: r CHAR: \r }
- { CHAR: t CHAR: \t }
- { CHAR: v CHAR: \v }
- { CHAR: ' CHAR: ' }
- { CHAR: \" CHAR: \" }
- { CHAR: \\ CHAR: \\ }
- { CHAR: ? CHAR: ? }
- { CHAR: ; CHAR: ; }
- { CHAR: [ CHAR: [ }
- { CHAR: ] CHAR: ] }
- { CHAR: = CHAR: = }
- } ?at [ bad-escape ] unless ;
-
-: (unescape-string) ( str -- )
- CHAR: \\ over index [
- cut-slice [ % ] dip rest-slice
- dup empty? [ "Missing escape code" throw ] when
- unclip-slice escape , (unescape-string)
- ] [ % ] if* ;
-
-: unescape-string ( str -- str' )
- [ (unescape-string) ] "" make ;
-
-: escape-string ( str -- str' )
- [
- [
- H{
- { CHAR: \a "\\a" }
- { CHAR: \b "\\b" }
- { CHAR: \f "\\f" }
- { CHAR: \n "\\n" }
- { CHAR: \r "\\r" }
- { CHAR: \t "\\t" }
- { CHAR: \b "\\v" }
- { CHAR: ' "\\'" }
- { CHAR: \" "\\\"" }
- { CHAR: \\ "\\\\" }
- { CHAR: ? "\\?" }
- { CHAR: ; "\\;" }
- { CHAR: [ "\\[" }
- { CHAR: ] "\\]" }
- { CHAR: = "\\=" }
- } ?at [ % ] [ , ] if
- ] each
- ] "" make ;
-
-: space? ( ch -- ? )
- "\s\t\n\r\f\v" member-eq? ;
-
-: unspace ( str -- str' )
- [ space? ] trim ;
-
-: unwrap ( str -- str' )
- 1 swap [ length 1 - ] keep subseq ;
-
-: uncomment ( str -- str' )
- ";#" [ over index [ head ] when* ] each ;
-
-: cleanup-string ( str -- str' )
- unspace unquote unescape-string ;
-
-SYMBOL: section
-SYMBOL: option
-
-: section? ( line -- index/f )
- {
- [ length 1 > ]
- [ first CHAR: [ = ]
- [ CHAR: ] swap last-index ]
- } 1&& ;
-
-: line-continues? ( line -- ? )
- ?last CHAR: \ = ;
-
-: section, ( -- )
- section get [ , ] when* ;
-
-: option, ( name value -- )
- section get [ second swapd set-at ] [ 2array , ] if* ;
-
-: [section] ( line -- )
- unwrap cleanup-string H{ } clone 2array section set ;
-
-: name=value ( line -- )
- option [
- [ swap [ first2 ] dip ] [
- "=" split1 [ cleanup-string "" ] [ "" or ] bi*
- ] if*
- dup line-continues? [
- dup length 1 - head cleanup-string
- dup last space? [ " " append ] unless append 2array
- ] [
- cleanup-string append option, f
- ] if
- ] change ;
-
-: parse-line ( line -- )
- uncomment unspace dup section? [
- section, 1 + cut [ [section] ] [ unspace ] bi*
- ] when* [ name=value ] unless-empty ;
-
-PRIVATE>
-
-: read-ini ( -- assoc )
- section off option off
- [ [ parse-line ] each-line section, ] { } make
- >hashtable ;
-
-: write-ini ( assoc -- )
- [
- dup string? [
- [ escape-string ] bi@ "%s=%s\n" printf
- ] [
- [ escape-string "[%s]\n" printf ] dip
- [ [ escape-string ] bi@ "%s=%s\n" printf ]
- assoc-each nl
- ] if
- ] assoc-each ;
-
-! FIXME: escaped comments "\;" don't work
-
-: string>ini ( str -- assoc )
- [ read-ini ] with-string-reader ;
-
-: ini>string ( assoc -- str )
- [ write-ini ] with-string-writer ;
+++ /dev/null
-Parses INI configuration files.
+++ /dev/null
-parsing
-file formats
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: oauth1 oauth1.private tools.test accessors kernel assocs
-strings namespaces urls ;
-
-{ "%26&b" } [ "&" "b" hmac-key ] unit-test
-{ "%26&" } [ "&" f hmac-key ] unit-test
-
-{ "B&http%3A%2F%2Ftwitter.com%2F&a%3Db" } [
- URL" http://twitter.com"
- "B"
- { { "a" "b" } }
- signature-base-string
-] unit-test
-
-{ "0EieqbHx0FJ/RtFskmRj9/TDpqo=" } [
- "ABC" "DEF" <token> consumer-token set
-
- URL" http://twitter.com"
- <request-token-params>
- 12345 >>timestamp
- 54321 >>nonce
- <request-token-request>
- post-data>>
- "oauth_signature" of
- >string
-] unit-test
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs base64 calendar checksums.hmac
-checksums.sha combinators fry http http.client kernel locals
-make math math.parser namespaces present random sequences
-sorting strings urls urls.encoding urls.private ;
-IN: oauth1
-
-SYMBOL: consumer-token
-
-TUPLE: token key secret user-data ;
-
-: <token> ( key secret -- token )
- token new
- swap >>secret
- swap >>key ;
-
-<PRIVATE
-
-TUPLE: token-params
-consumer-token
-timestamp
-nonce ;
-
-: new-token-params ( class -- params )
- new
- consumer-token get >>consumer-token
- now timestamp>unix-time >integer >>timestamp
- 16 random-bytes bytes>hex-string >>nonce ; inline
-
-: present-base-url ( url -- string )
- [
- [ unparse-protocol ]
- [ unparse-authority ]
- [ path>> url-encode % ] tri
- ] "" make ;
-
-:: signature-base-string ( url request-method params -- string )
- [
- request-method % "&" %
- url present-base-url url-encode-full % "&" %
- params assoc>query url-encode-full %
- url query>> [ assoc>query "&" prepend url-encode-full % ] when*
- ] "" make ;
-
-: hmac-key ( consumer-secret token-secret -- key )
- [ url-encode-full ] [ "" or url-encode-full ] bi* "&" glue ;
-
-: make-token-params ( params quot -- assoc )
- '[
- "1.0" "oauth_version" ,,
- "HMAC-SHA1" "oauth_signature_method" ,,
-
- _
- [
- [ consumer-token>> key>> "oauth_consumer_key" ,, ]
- [ timestamp>> "oauth_timestamp" ,, ]
- [ nonce>> "oauth_nonce" ,, ]
- tri
- ] bi
- ] H{ } make ; inline
-
-:: sign-params ( url request-method consumer-token request-token params -- signed-params )
- params sort-keys :> params
- url request-method params signature-base-string :> sbs
- consumer-token secret>> request-token dup [ secret>> ] when hmac-key :> key
- sbs key sha1 hmac-bytes >base64 >string :> signature
- params { "oauth_signature" signature } prefix ;
-
-: extract-user-data ( assoc -- assoc' )
- [
- drop
- { "oauth_token" "oauth_token_secret" } member? not
- ] assoc-filter ;
-
-: parse-token ( response data -- token )
- nip
- query>assoc
- [ [ "oauth_token" ] dip at ]
- [ [ "oauth_token_secret" ] dip at ]
- [ extract-user-data ]
- tri
- [ <token> ] dip >>user-data ;
-
-PRIVATE>
-
-TUPLE: request-token-params < token-params
-{ callback-url initial: "oob" } ;
-
-: <request-token-params> ( -- params )
- request-token-params new-token-params ;
-
-<PRIVATE
-
-:: <token-request> ( url consumer-token request-token params -- request )
- url "POST" consumer-token request-token params sign-params
- url
- <post-request> ;
-
-: make-request-token-params ( params -- assoc )
- [ callback-url>> "oauth_callback" ,, ] make-token-params ;
-
-: <request-token-request> ( url params -- request )
- [ consumer-token>> f ] [ make-request-token-params ] bi
- <token-request> ;
-
-PRIVATE>
-
-: obtain-request-token ( url params -- token )
- <request-token-request> http-request parse-token ;
-
-TUPLE: access-token-params < token-params request-token verifier ;
-
-: <access-token-params> ( -- params )
- access-token-params new-token-params ;
-
-<PRIVATE
-
-: make-access-token-params ( params -- assoc )
- [
- [ request-token>> key>> "oauth_token" ,, ]
- [ verifier>> "oauth_verifier" ,, ]
- bi
- ] make-token-params ;
-
-: <access-token-request> ( url params -- request )
- [ consumer-token>> ]
- [ request-token>> ]
- [ make-access-token-params ] tri
- <token-request> ;
-
-PRIVATE>
-
-: obtain-access-token ( url params -- token )
- <access-token-request> http-request parse-token ;
-
-SYMBOL: access-token
-
-TUPLE: oauth-request-params < token-params access-token ;
-
-: <oauth-request-params> ( -- params )
- oauth-request-params new-token-params
- access-token get >>access-token ;
-
-<PRIVATE
-
-:: signed-oauth-request-params ( request params -- params )
- request url>>
- request method>>
- params consumer-token>>
- params access-token>>
- params
- [
- access-token>> key>> "oauth_token" ,,
- request post-data>> %%
- ] make-token-params
- sign-params ;
-
-: build-auth-string ( params -- string )
- [ [ present url-encode-full ] bi@ "\"" "\"" surround "=" glue ] { } assoc>map
- ", " join "OAuth realm=\"\", " prepend ;
-
-PRIVATE>
-
-: set-oauth ( request params -- request )
- dupd signed-oauth-request-params build-auth-string
- "Authorization" set-header ;
+++ /dev/null
-web
-network
+++ /dev/null
-Björn Lindqvist
+++ /dev/null
-! Copyright (C) 2018 Björn Lindqvist.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax ;
-IN: oauth2
-
-ARTICLE: "oauth2" "Oauth2 Support"
-"The " { $vocab-link "oauth2" } " vocab implements client support for the Oauth2 protocol."
-$nl
-"To use the oauth2 vocab, first create an instance of the " { $link oauth2 } " class to represent the Oauth2 provider's settings. The slots 'auth-uri' and 'token-uri' should be set to the providers authentication and token uri:ss. The 'redirect-uri' should hold the URI to a callback URL, which usually must be registered with the provider. The 'client-id' and 'client-secret' slots identifies the application and should be kept secret. For example, to initialize an oauth2 instance compatible with GitHub's api use:"
-{ $unchecked-example
- "\"https://github.com/login/oauth/authorize\""
- "\"https://github.com/login/oauth/access_token\""
- "\"https://localhost:8080\" \"client-id\" \"client-secret\""
- "\"user\" { } oauth2 boa"
-}
-"Then to get hold of an access token, use the " { $link console-flow } " word and enter the verification code given by the provider. This puts a " { $link tokens } " instance on the stack whose slot 'access' contains the actual access token. It can be used to make API calls on behalf of the user. For example, to list all the user's GitHub repositories:"
-{ $unchecked-example
- "\"https://api.github.com/user/repos\" \"access-token\""
- "oauth-http-get"
-}
-"Some providers limit the validity of the access token. If so, the provider sets the 'expiry' slot on the " { $link tokens } " tuple to the tokens expiration date and 'refresh' to a refresh token. The refresh token can be used with the " { $link refresh-flow } " word to request new access tokens from the provider."
-{ $notes "The vocab only implements the console flow, but other methods for acquiring tokens could be added in the future" } ;
-
-ABOUT: "oauth2"
+++ /dev/null
-USING: accessors calendar kernel oauth2 tools.test urls ;
-
-! assoc>tokens
-{
- "blah" "bleh" t
-} [
- H{
- { "expires_in" 3600 }
- { "access_token" "blah" }
- { "token_type" "Bearer" }
- { "refresh_token" "bleh" }
- } assoc>tokens
- [ access>> ] [ refresh>> ] [ expiry>> timestamp? ] tri
-] unit-test
-
-! oauth2>auth-uri
-{
- URL" https://github.com/login/oauth/authorize?client_id=1234&scope=user&redirect_uri=test-pest&state=abcd&response_type=code&access_type=offline"
-} [
- "https://github.com/login/oauth/authorize"
- "https://github.com/login/oauth/access_token"
- "test-pest"
- "1234" "password" "user"
- { { "state" "abcd" } } oauth2 boa oauth2>auth-uri
-] unit-test
-
-! tokens-params
-{
- {
- { "code" "hej" }
- { "client_id" "1234" }
- { "client_secret" "password" }
- { "redirect_uri" "test-pest" }
- { "state" "abcd" }
- { "grant_type" "authorization_code" }
- }
-} [
- "https://github.com/login/oauth/authorize"
- "https://github.com/login/oauth/access_token"
- "test-pest"
- "1234" "password" "user" { { "state" "abcd" } } oauth2 boa
- "hej" tokens-params
-] unit-test
+++ /dev/null
-! Copyright (C) 2016 Björn Lindqvist.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs calendar combinators http.client io
-json.reader kernel make math.order sequences unicode urls
-webbrowser ;
-IN: oauth2
-
-: console-prompt ( query -- str/f )
- write flush readln [ blank? ] trim [ f ] when-empty ;
-
-: post-json-request ( params token-uri -- assoc )
- <post-request> dup header>> "application/json" "Accept" rot set-at
- http-request nip json> ;
-
-TUPLE: tokens access refresh expiry ;
-
-: assoc>expiry ( json -- expiry )
- "expires_in" of [ seconds now time+ ] [ f ] if* ;
-
-: assoc>tokens ( json -- tokens )
- [ "access_token" of ]
- [ "refresh_token" of ]
- [ assoc>expiry ] tri tokens boa ;
-
-: access-expired? ( tokens -- ? )
- expiry>> [ now before? ] [ f ] if* ;
-
-: update-tokens ( tokens1 tokens2 -- tokens1 )
- 2dup expiry>> >>expiry drop access>> >>access ;
-
-TUPLE: oauth2
- auth-uri
- token-uri
- redirect-uri
- client-id
- client-secret
- scope
- extra-params ;
-
-: tokens-params ( oauth2 code -- params )
- [
- "code" ,,
- {
- [ client-id>> "client_id" ,, ]
- [ client-secret>> "client_secret" ,, ]
- [ redirect-uri>> "redirect_uri" ,, ]
- [ extra-params>> %% ]
- } cleave
- "authorization_code" "grant_type" ,,
- ] { } make ;
-
-: refresh-params ( oauth2 refresh -- params )
- [
- "refresh_token" ,,
- [ client-id>> "client_id" ,, ]
- [ client-secret>> "client_secret" ,, ]
- [ extra-params>> %% ] tri
- "refresh_token" "grant_type" ,,
- ] { } make ;
-
-: auth-params ( oauth2 -- params )
- [
- {
- [ client-id>> "client_id" ,, ]
- [ scope>> "scope" ,, ]
- [ redirect-uri>> "redirect_uri" ,, ]
- [ extra-params>> %% ]
- } cleave
- "code" "response_type" ,,
- "offline" "access_type" ,,
- ] { } make ;
-
-: oauth2>auth-uri ( oauth2 -- uri )
- [ auth-uri>> >url ] [ auth-params ] bi set-query-params ;
-
-! Other flows can be useful to support too.
-: console-flow ( oauth2 -- tokens/f )
- dup oauth2>auth-uri open-url
- "Enter verification code: " console-prompt
- [
- dupd tokens-params swap token-uri>> post-json-request
- assoc>tokens
- ] [ drop f ] if* ;
-
-: refresh-flow ( oauth2 tokens -- tokens' )
- dupd refresh>> refresh-params swap token-uri>> post-json-request
- assoc>tokens ;
-
-! Using the token to access secured resources.
-: add-token ( request url -- )
- "Bearer " prepend "Authorization" rot header>> set-at ;
-
-: oauth-http-get ( url access-token -- response data )
- [ <get-request> dup ] dip add-token http-request ;
+++ /dev/null
-web
-network
projects / factor.git / commitdiff