├── .gitignore ├── README.md ├── bot-api.r3 ├── bot-config-sample.r ├── changes.txt ├── commands ├── bot-help-command.r3 ├── bot-version-command.r3 ├── carls-blog-comments.r3 ├── curecode-command.r3 ├── delete-message-command.r3 ├── do-ideone-expression-command.r3 ├── do-rebol-and-rebol-like-expression-command.r3 ├── fetch-command.r3 ├── introduce-me.r3 ├── meaning-of-life-command.r3 ├── private-session-command.r3 ├── return-a-greeting-command.r3 ├── save-my-details-command.r3 ├── search-command.r3 ├── send-tweet-command.r3 ├── show-links-by-user-command.r3 ├── show-links-command.r3 ├── shut-up-command.r3 ├── source-command.r3 ├── tag-handling-command.r3 ├── what-is-time-relative-to-gmt-command.r3 ├── who-do-you-know-command.r3 ├── who-is-online-command.r3 └── who-is-user-command.r3 ├── prot-http.r ├── rebolbot.r3 ├── server ├── eval.reb └── evalr2.r ├── shrink.reb ├── so-speak.reb ├── twitter-config-sample.r3 └── twitter.r3 /.gitignore: -------------------------------------------------------------------------------- 1 | /tmp-hold-cmds/ 2 | /tmp/ 3 | /r3.exe 4 | /bot-config.r 5 | /visitors.r 6 | /lastmessage-no.r 7 | /known-users.r 8 | /bot-expressions.r 9 | /messages/ 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![The all-seeing eye of the RebolBot! Well, maybe it's just a Rebol block.][1] 2 | 3 | ##Screenshot / Code Snippet 4 | 5 | @Rebolbot help 6 | @GrahamChiu I respond to these commands: 7 | delete [ silent ] "in reply to a bot message will delete if in time" 8 | do expression "evaluates Rebol expression in a sandboxed interpreter (/x)" 9 | help "this help (/? and /h)" 10 | keys "returns known keys (/k)" 11 | remove key "removes key (authorized user) (/rm)" 12 | save my details url! "saves your details with url" 13 | save key [string! word!] description [string!] link [url!] "save key with description and link (/s)" 14 | show [all ][ recent ] links by user "shows links posted in messages by user" 15 | show links [ like url ] "shows saved links" 16 | show me your youtube videos "shows saved youtube videos" 17 | who is user "returns user details and page" 18 | whom do you know "returns a list of all known users" 19 | ? key [ for user | @user ] "Returns link and description" 20 | version "version of bot (/v)" 21 | 22 | 23 | ##About 24 | 25 | RebolBot is a chat bot written in Rebol. It specifically targets the StackOverflow chat rooms, but could be modified with only a little effort to work with any chat system that provides an API for accessing and posting messages or with those providing nothing more than a web form (of course its functionality would depend on how much of the chat activity is accessible either through the API or by scraping). You might think that this is what you could do in any language, but wait until you've seen Rebol - it makes text (and binary) parsing and data munging child's play. 26 | 27 | A running instance of the bot hangs out in the [Rebol and RED][2] room where it answers questions, executes Rebol code in a sandboxed environment for teaching purposes, and does all sorts of other useful things. It has a natural English language dialected interface, and aims to be on call 24/7. It runs under its own account. Help is available in the [Rebol and RED][2] room. 28 | 29 | The bot runs as a console process and can interact with a chat systems in various ways with ease. As implemented it is using the REST API that is visible, but not documented, when you use *chat.stackoverflow.com*. 30 | 31 | If you'd like to use this bot to evaluate code in an arbitrary programming language, you should have access to a remote service that can accept a string to be evaluated. To see what the RebolBot does with the HTML that is returned from the remote service it is currently using, take a look at the `evaluate-expression` function. In fact the remote service doesn't have to be a service in a formal sense - any of the many REPLs out there could serve as an evaluation target since Rebol makes it very easy to post to and parse results from any site. Make sure you have the OK of the site owner though, before you go and send more traffic his way than s/he's expecting. 32 | 33 | 34 | Keep in mind that this bot is very young (only about a week now) so you can still expect some rough edges to show themselves here and there. Again, you are welcome to drop by the Rebol chat room and discuss the script in general, or have us try to help with customizing it for your needs. 35 | 36 | [Rebol][5] (and [Red][6]) - keepin' it simple! 37 | 38 | ###Installation 39 | - Clone this repo and get yourself a Rebol binary (just one file) for your platform of choice. 40 | - Put the executable in the same directory as rebolbot.r3 and make sure it can run as an application (`chmod +x`) on Linux. 41 | - Rename bot-config-sample.r to bot-config.r. Edit this file to specify the chat room to be monitored as well as the fkey and cookies needed for the bot to appeared as the desired StackOverflow user. 42 | - Decide which commands you wish to run and move the rest out of the commands directory. This can be done before the bot is run or at runtime, with the bot still running. The bot monitors this directory and will reconfigure itself based on what commands are found there. 43 | - invoke the rebolbot.r3 script with the Rebol binary you downloaded. To do this, drag-and-drop the script on the executable if there's a GUI or follow the steps at [http://rebol.com](http://www.rebol.com/r3/docs/guide/basics-run.html) showing how to run from the command-line (CLI). 44 | - NOTE: need to provide a better example configuration here ... 45 | 46 | #### `botname` and reply loop 47 | 48 | `botname` option can be misleading, as it doesn't represent the name of the account the bot is using, but the name the bot should listen to. This is, when the bot finds a `@botname` mention at the recent messages, it will assume the message is a request and will scan the message to parse commands. 49 | 50 | If you set `botname` to be your own username, and you interact with the bot, the bot could end in a reply loop in case the command cannot be processed. To avoid this problem, set `botname` to a different username, like `@RebolBot`, `@REBOLparser` or `@etc`. 51 | 52 | ###License 53 | 54 | [Apache License, Version 2.0][3] 55 | 56 | [Rebol Binaries][4] - So tiny! Yes, that's all you'll need. No install. 57 | 58 | ###Platform 59 | 60 | The script can be run on any platform supported by Rebol (Linux, OS X, Windows, Android) 61 | 62 | ##Contact 63 | 64 | [Graham Chiu on SO chat][7] 65 | 66 | [Adrian Sampaleanu on SO chat][8] 67 | 68 | ##Code 69 | 70 | RebolBot is currently under 400 lines of Rebol for the main bot (not including command modules which can be included or not, as desired). Commands vary from a couple of lines to around 130 for the most complex. If you want to hack on code, feel free to fork the repo and submit pull requests for changes you feel are generally useful, new commands, as well as for bug fixes. 71 | 72 | ##The Goal 73 | 74 | [Rebol][5] and [Red][6] are fighting software complexity... 75 | 76 | Software systems have become too complex, layers upon layers of complexity, each more brittle and vulnerable to failure. In the end software becomes the problem, not the solution. We rebel against such complexity, fighting back with the most powerful tool available: language itself. 77 | 78 | 79 | [1]: http://i.stack.imgur.com/ygAOt.jpg 80 | [2]: http://chat.stackoverflow.com/rooms/291/rebol-and-red 81 | [3]: http://www.apache.org/licenses/LICENSE-2.0.html 82 | [4]: http://www.rebolsource.net 83 | [5]: http://www.rebol.com 84 | [6]: http://www.red-lang.org 85 | [7]: http://chat.stackoverflow.com/users/76852/graham-chiu 86 | [8]: http://chat.stackoverflow.com/users/1792095/adrian 87 | [9]: http://getfirebug.com/ 88 | [10]: http://www.wireshark.org/ 89 | -------------------------------------------------------------------------------- /bot-api.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "API" 3 | Name: bot-api 4 | Type: module 5 | Version: 1.0.0 6 | Options: [] 7 | Exports: [ 8 | about-users 9 | botname 10 | bot-expressions 11 | chat-length-limit 12 | commands 13 | done 14 | delete-message 15 | from-now 16 | get-userid 17 | greet-message 18 | header 19 | html-url 20 | id-rule 21 | log 22 | login2so 23 | low-rep-message 24 | max-scan-messages 25 | message-id 26 | no-of-messages 27 | parent-id 28 | person-id 29 | pause-period 30 | percent-encode 31 | privileged-users 32 | profile-url 33 | read-messages 34 | read-message 35 | referrer-url 36 | reply 37 | speak 38 | speak-private 39 | storage 40 | timestamp 41 | to-dash 42 | to-idate 43 | to-itime 44 | to-markdown-code 45 | two-minutes-ago 46 | unix-to-date 47 | unix-now 48 | url-encode 49 | user-name 50 | ideone-user 51 | ideone-pass 52 | ideone-url 53 | ] 54 | ] 55 | 56 | ; The name of the bot 57 | ; Configured in bot-config.r 58 | botname: _ 59 | 60 | ; The command modules loaded by the bot 61 | commands: [] 62 | 63 | ; The message new users will be greeted with 64 | ; Configured in bot-config.r 65 | greet-message: "" 66 | 67 | ; The message new users with a reputation lower than 20 68 | ; will be greeted with. 69 | ; Configured in bot-config.r 70 | low-rep-message: "" 71 | 72 | ; The number of messages to fetch at a time 73 | no-of-messages: _ 74 | 75 | ; The maximum number of characters allowed by the chat system 76 | chat-length-limit: _ 77 | 78 | ; Users who have special privileges with the bot (e.g. remove keys) 79 | ; privileged-users: ["HostileFork" 211160 "Graham Chiu" 76852 "johnk" 1864998] 80 | privileged-users: [] 81 | 82 | ; Mapping of username to info-link + timezone 83 | ; about-users: [ 84 | ; earl [https://github.com/earl 1:00] 85 | ; graham [https://github.com/gchiu/ 13:00] 86 | ; ] 87 | about-users: [] 88 | 89 | ; Mapping of keyword to description + URL 90 | ; bot-expressions: [ 91 | ; "help" ["FAQ" http://rebolsource.net/go/chat-faq] 92 | ; "tutorial" ["Introduction to Rebol" http://www.rebol.com/rebolsteps.html] 93 | ; "Devcon" ["Red Video from Devcon 2013" https://www.youtube.com/watch?v=JjPKj0_HBTY] 94 | ; ] 95 | bot-expressions: [] 96 | 97 | ; Signifies that a command's dialect rule is done 98 | done: false 99 | 100 | ; The parse rule for user IDs 101 | id-rule: _ 102 | 103 | ; The main chat URL with highlight turned off 104 | html-url: _ 105 | 106 | ; The main chat URL 107 | referrer-url: _ 108 | 109 | ideone-url: ideone-pass: ideone-user: profile-url: person-id: user-name: message-id: parent-id: timestamp: storage: _ 110 | 111 | get-userid: func [txt][] 112 | 113 | read-messages: func [cnt] [] 114 | 115 | read-message: func [message-id] [] 116 | 117 | delete-message: func [parent-id message-id /silent] [] 118 | 119 | speak-private: func [message room-id] [] 120 | 121 | log: func [text] [] 122 | 123 | speak: func [message] [] 124 | 125 | reply: func [message-id text [string! block!]] [] 126 | 127 | percent-encode: func [char [char!]] [] 128 | 129 | url-encode: func [text] [] 130 | 131 | to-markdown-code: func [txt] [] 132 | 133 | unix-to-date: func [ unix [string! integer!]] [] 134 | 135 | from-now: func [d [date!]][] 136 | 137 | unix-now: does [] 138 | 139 | two-minutes-ago: does [] 140 | 141 | to-itime: func [ 142 | {Returns a standard internet time string (two digits for each segment)} 143 | time [time! number! block!] 144 | ] [] 145 | 146 | to-idate: func [ 147 | {Returns a standard Internet date string.} 148 | date [date!] 149 | ] [] 150 | 151 | to-dash: func [ 152 | {Returns name replacing space and . with -} 153 | username [string!] 154 | ][] 155 | -------------------------------------------------------------------------------- /bot-config-sample.r: -------------------------------------------------------------------------------- 1 | bot-user: "SO user to authenticate as - (must be a stackexchange SO user not a google sso)" 2 | bot-pass: "password for user" 3 | bot-room: http://chat.stackoverflow.com/rooms// 4 | botname: "@NameMe" 5 | room-id: 0 6 | room-descriptor: "-- room name --" 7 | log-file: %log.txt 8 | greet-message: "Welcome to the *** room. See our [FAQ](https://host.com/faq)" 9 | low-rep-message: " Sorry, your reputation score is too low to chat at present. Not our rules, but those of Stackoverflow. If you were to [answer some questions](http://stackoverflow.com/questions/tagged/rebol), or [ask some](http://stackoverflow.com/questions/ask), we might be able to help by upvoting you. In the meantime, have a look at a [Rebol introduction](http://rebol.com/rebolsteps.html)." 10 | -------------------------------------------------------------------------------- /changes.txt: -------------------------------------------------------------------------------- 1 | 0.0.33 2 | - first wave of bot modularization is in - commands are modules 3 | - commands can be enabled/disabled at runtime 4 | 5 | 0.0.31 6 | - rebolbot now uses a safer http read for tryrebol 7 | 8 | 0.0.27 9 | - many new commands - find, present? -------------------------------------------------------------------------------- /commands/bot-help-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Bot Help - command" 3 | Name: bot-help-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {help "this help"} 12 | 13 | dialect-rule: ['help (done: true provide-help)] 14 | 15 | provide-help: func [] [ 16 | reply message-id rejoin [{I respond to these commands 17 | Note: [] means optional input or shows expected datatype, (|) means choice:} newline 18 | sort/skip collect [foreach command commands [keep command/help-string keep newline]] 2 19 | {? key [ for user | @user ] "Returns link and description"} 20 | ] 21 | ] 22 | -------------------------------------------------------------------------------- /commands/bot-version-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Get bot version - command" 3 | Name: bot-version-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {version "version of bot"} 12 | 13 | dialect-rule: ['version (done: true reply message-id ajoin [system/script/header/version " " last system/script/header/date])] 14 | -------------------------------------------------------------------------------- /commands/carls-blog-comments.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Display Carl's blog comments" 3 | Name: carls-blog-comments 4 | Type: module 5 | Role: command 6 | Version: 1.0.1 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {Carl's blog "when did we last check for new comments from rebol.com/blog.r"} 12 | 13 | last-updated-file: %blog-last-updated.r3 14 | 15 | dialect-rule: [ 16 | [ 'carls | 'carl | 'carl's ] 'blog ( 17 | done: true 18 | reply message-id reform [ 19 | "I last checked Carl's blog for new comments on" 20 | any [ 21 | attempt [ load last-updated-file ] 22 | "... I forget. Ask me later." 23 | ] 24 | ] 25 | ) 26 | ] 27 | 28 | process-blog: function [ 29 | ] [ 30 | blog-comment-data: copy [] 31 | ;;blog-comment-data-spec: [ 32 | ;; article article-link [ name datetime comment name datetime comment ] article aticle-link [ name datetime comment ] 33 | ;;] 34 | diff-to-localtime: -8:00:00 35 | comment-length: 140 36 | article: copy "" 37 | base-article-link: http://www.rebol.com 38 | article-link: copy "" 39 | comment-content: copy "" 40 | datetime: copy "" 41 | name: copy "" 42 | 43 | attempt [ 44 | article-rule: [ 45 | {} thru {">} copy article to 46 | (append blog-comment-data reduce [to-string article article-link copy [] ]) 47 | ] 48 | name-rule: [ 49 | {} copy datetime to 54 | (append last blog-comment-data to-date replace to-string datetime " " "/") 55 | ] 56 | comment-rule: [ 57 | {} copy comment-content to 58 | (append last blog-comment-data to-string comment-content) 59 | ] 60 | blog: read http://www.rebol.com/cgi-bin/blog.r?cmt-week=1 61 | 62 | parse blog [ 63 | any [ article-rule | name-rule | datetime-rule | comment-rule | skip ] 64 | ] 65 | 66 | last-updated: any [ attempt [ load last-updated-file ] (now + diff-to-localtime) ] 67 | foreach [ article article-link comments ] blog-comment-data [ 68 | foreach [ name datetime comment-content ] comments [ 69 | if positive? (difference (datetime + diff-to-localtime) last-updated) [ 70 | ;print [ article name datetime last-updated] 71 | remove-each tag comment-content: decode 'markup to binary! comment-content [tag? tag] 72 | comment-content: head clear skip reform comment-content comment-length 73 | comment-content: copy/part comment-content any [ find/last comment-content " " length? comment-content ] 74 | speak reform [ name "-" article comment-content "..." join-of base-article-link (to string! article-link) ] 75 | ] 76 | ] 77 | ] 78 | save last-updated-file (now + diff-to-localtime) 79 | ] 80 | ] 81 | 82 | pulse-callback: does [ process-blog ] 83 | -------------------------------------------------------------------------------- /commands/curecode-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Curecode - command" 3 | Name: cc-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Date: 16-June-2013 9 | Author: "Graham Chiu" 10 | Options: [private] 11 | ] 12 | 13 | help-string: {cc id "retrieves curecode data"} 14 | 15 | target: _ 16 | 17 | 18 | dialect-rule: [ 19 | 'cc set target integer! ( 20 | done: true 21 | use [ result ][ 22 | attempt [ 23 | result: load join-of http://curecode.org/rebol3/api.rsp?type=ticket&show=all&id= target 24 | if parse result [ 'ok set result block! ][ 25 | reply message-id mold result 26 | ] 27 | ] 28 | ] 29 | ) 30 | ] 31 | -------------------------------------------------------------------------------- /commands/delete-message-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Delete the last bot message - command" 3 | Name: delete-last-message 4 | Type: module 5 | Role: command 6 | Version: 1.0.1 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {delete [ loud ] "in reply to a bot message will delete if in time"} 12 | 13 | loud: false 14 | 15 | dialect-rule: [ 16 | 'delete (done: true loud: false ) 17 | opt [ copy loud word! ] ( 18 | either all [ block? loud loud/1 = 'loud][ 19 | delete-message parent-id message-id 20 | ][ 21 | print "not calling loud" 22 | delete-message/silent parent-id message-id 23 | ] 24 | ) 25 | ] 26 | -------------------------------------------------------------------------------- /commands/do-ideone-expression-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Evaluate an expression against an ideone supported language interpreter - command" 3 | Name: do-ideone-expression-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {do/ideone which-lang [word! string! integer!] expression "evaluates a source expression for the specified language"} 12 | 13 | language: expression: _ 14 | 15 | dialect-rule: [ 16 | 'do/ideone [set language word! | set language string! | set language integer!] copy expression to end 17 | (done: true 18 | attempt [ 19 | probe mold/only expression 20 | evaluate-by-ideone ideone-user ideone-pass mold/only expression language "" 21 | ] 22 | ) 23 | ] 24 | 25 | soap-execute-template: {$a$b$c$d$e$f$g} 26 | 27 | soap-response-template: {$user$pass$link11111} 28 | 29 | evaluate-by-ideone: func [user pass source [string!] language [word! string! integer!] inpt [string!] 30 | /local result result2 error status link inputs output 31 | ] [ 32 | error: status: link: _ 33 | ;print "in eval ideone" 34 | 35 | ;?? source 36 | source: head remove source head remove back tail source 37 | ;?? source 38 | 39 | if not integer? language [ 40 | language: select [ 41 | "forth" 107 42 | "ruby" 17 43 | "javascript" 35 44 | "scheme" 33 45 | "python" 4 46 | "perl" 3 47 | ] to string! language 48 | ] 49 | if blank? language [ 50 | reply message-id "Unsupported language" 51 | return 52 | ] 53 | ;?? user ?? pass ?? source ?? language ?? inpt 54 | print reword soap-execute-template reduce [ 55 | 'a user 56 | 'b pass 57 | 'c source 58 | 'd language 59 | 'e inpt 60 | 'f "1" 61 | 'g "1" 62 | ] 63 | result: write ideone-url reduce ['SOAP ( 64 | reword soap-execute-template reduce [ 65 | 'a user 66 | 'b pass 67 | 'c source 68 | 'd language 69 | 'e inpt 70 | 'f "1" 71 | 'g "1" 72 | ] 73 | ) 74 | ] 75 | ; should get an error code 76 | probe decode 'markup result 77 | if parse decode 'markup result [ 78 | thru copy error to 79 | thru copy status to 80 | thru "link" 81 | copy link to 82 | to end] [ 83 | if all [ 84 | error/1 = "error" 85 | status/1 = "OK" 86 | ] [ 87 | ; we have a link value to get the result 88 | probe reword soap-response-template reduce [ 89 | 'user user 90 | 'password pass 91 | 'link link/1 92 | ] 93 | ; wait before picking up the result 94 | wait 5 95 | 96 | result2: write ideone-url reduce ['SOAP ( 97 | reword soap-response-template reduce [ 98 | 'user user 99 | 'pass pass 100 | 'link link/1 101 | ] 102 | ) 103 | ] 104 | if result2 [ 105 | if parse decode 'markup result2 [ 106 | thru "source" 107 | thru copy inputs to 108 | thru "output" 109 | thru copy output to to end 110 | ] [ 111 | reply message-id rejoin [ 112 | " RebolBot uses http://ideone.com (c) http://sphere-research.com" newline 113 | " " decode-xml inputs/1 newline 114 | " " decode-xml output/1 115 | ] 116 | ] 117 | ] 118 | ] 119 | ] 120 | ] 121 | 122 | 123 | -------------------------------------------------------------------------------- /commands/do-rebol-and-rebol-like-expression-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Evaluate a Rebol expression - command" 3 | Name: do-rebol-and-rebol-like-expression-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {(do|do/2|do/red|do/boron|do/echo) expression "evaluates Rebol/Rebol-like expression in a sandboxed interpreter. echo repeats exact command sent to r3"} 12 | 13 | expression: target: _ 14 | 15 | dialect-rule: [ 16 | [ ; do-rule 17 | [/x | 'do] copy expression to end 18 | (done: true 19 | print/eval ["attempt evaluation on Google cloud " expression] 20 | ; lib/speak "Attempting evaluation on Google cloud" 21 | attempt [ 22 | evaluate-expression mold/only/all expression 23 | ] 24 | ) 25 | ] | 26 | [ ; echo-rule 27 | 'do/echo copy expression to end 28 | (done: true 29 | attempt [ 30 | print "evaluating echo expression" 31 | evaluate-expression/echo mold/only/all expression 32 | ] 33 | ) 34 | ] | 35 | [ ; do2-rule 36 | ['do/2 | 'do/rebol2] copy expression to end 37 | (done: true 38 | attempt [ 39 | print "evaluating rebol2 expression" 40 | evaluate-expression/r2 mold/only expression 41 | ] 42 | ) 43 | ] | 44 | [ ; do-boron-rule 45 | 'do/boron copy expression to end 46 | (done: true 47 | attempt [ 48 | print "evaluating boron expression" 49 | evaluate-expression/boron mold/only expression 50 | ] 51 | ) 52 | ] | 53 | [ ; do-red-rule 54 | 'do/red copy expression to end 55 | (done: true 56 | attempt [ 57 | print "evaluating red-lang expression" 58 | evaluate-expression/red mold/only expression 59 | ] 60 | ) 61 | ] | 62 | [ ; read-raw-rule 63 | 'read 'raw set target url! ( 64 | done: true 65 | raw-read target 66 | ) 67 | ] 68 | ] 69 | 70 | 71 | ;- configuration urls 72 | remote-execution-url: [ 73 | rebol3 http://104.196.25.210/cgi-bin/eval 74 | rebol2 http://104.196.25.210/cgi-bin/evalr2 75 | boron http://tryrebol.esperconsultancy.nl/do/Boron 76 | red http://tryrebol.esperconsultancy.nl/do/Red 77 | ] 78 | 79 | ; mini-http is a minimalistic http implementation 80 | mini-http: func [ url [url!] method [word! string!] code [string!] timeout [integer!] 81 | /local url-obj http-request payload result port 82 | ][ 83 | http-request: {$method $path HTTP/1.0 84 | Host: $host 85 | User-Agent: Mozilla/5.0 86 | Accept: text/html 87 | Referer: http://$host 88 | Content-Length: $len 89 | Content-Type: text/plain; charset=UTF-8 90 | 91 | $code} 92 | 93 | url-obj: construct/with sys/decode-url url make object! copy [port-id: 80 path: ""] 94 | if empty? url-obj/path [ url-obj/path: copy "/" ] 95 | payload: reword http-request reduce [ 96 | 'method method 97 | 'path url-obj/path 98 | 'host url-obj/host 99 | 'len length? code 100 | 'code code 101 | ] 102 | 103 | port: make port! rejoin [tcp:// url-obj/host ":" url-obj/port-id] 104 | port/awake: func [event] [ 105 | switch/default event/type [ 106 | lookup [open event/port false ] 107 | connect [write event/port to binary! join-of payload newline false] 108 | wrote [read event/port false] 109 | read done [ 110 | ; probe event/port/data 111 | result: to-string event/port/data true ] 112 | ][ true ] 113 | ] 114 | open port 115 | either port? wait [ port timeout ][ 116 | result 117 | ][ ; timeout 118 | _ 119 | ] 120 | ] 121 | 122 | raw-read: func [target [url!] 123 | /local result err 124 | ][ 125 | if error? set/any 'err try [ 126 | either result: mini-http target 'GET "" 60 [ 127 | reply message-id result 128 | ][ 129 | reply message-id "HTTP timeout" 130 | ] 131 | ][ 132 | reply message-id mold err 133 | ] 134 | ] 135 | 136 | extract-http-response: func [http-text [string!] 137 | /local result code bodytext server-code 138 | ][ 139 | digit: charset [ #"0" - #"9" ] 140 | either parse http-text [ thru "HTTP/1." [ "0" | "1" ] some space copy code 3 digit some space copy server-code to newline 141 | thru "^/^/" copy bodytext to end ][ 142 | trim/head/tail bodytext 143 | ][ 144 | make object! compose [ error: (server-code) code: (code) ] 145 | ] 146 | ] 147 | 148 | evaluate-expression: func [expression 149 | /r2 "rebol2" 150 | /boron "boron" 151 | /red "RED" 152 | /echo "echo" 153 | /local output html error-url exp execute-url speak 154 | ] [ 155 | print "entered evaluate-expression" 156 | output: html: error-url: _ 157 | dump remote-execution-url 158 | execute-url: select remote-execution-url 159 | case [ 160 | r2 ['rebol2] 161 | boron ['boron] 162 | red ['red] 163 | echo ['rebol3] 164 | true ['rebol3] 165 | ] 166 | 167 | print ["attempting evaluation at: " execute-url] 168 | dump expression 169 | html: to string! write execute-url compose [ POST (expression) ] 170 | ;; -- this begins the change from using native http 171 | ; if blank? html: mini-http execute-url 'POST form expression 60 [ 172 | ; speak "tryrebol server timed out" 173 | ; return 174 | ; ] 175 | ; ; speak form type? html 176 | ; if object? html: extract-http-response html [ 177 | ; print "html is object!" 178 | ; speak mold html 179 | ; return 180 | ; ] 181 | ;; --- and ends the change from using native http scheme 182 | 183 | parse html [thru copy output: to ] 184 | ; output: decode-xml output 185 | ; if an error, remove part of the error string and parse out the help page 186 | 187 | if find output "*** ERROR" [ 188 | replace output "try do either either either -apply-" "" 189 | parse html [thru { "] else ["~r3> "] dump: expression 198 | either blank? error-url 199 | [ "" ] 200 | [ ajoin [" ; " error-url newline " "]] 201 | either echo 202 | [ ajoin [ " >> " trim expression newline ] ] 203 | [ "" ] 204 | " " output 205 | ] 206 | print "finished speak" 207 | ] 208 | -------------------------------------------------------------------------------- /commands/fetch-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Fetch - command" 3 | Name: fetch-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Date: 16-June-2013 9 | Author: "Graham Chiu" 10 | Options: [private] 11 | ] 12 | 13 | help-string: {fetch id "retrieves stored JSON message by its message-id"} 14 | 15 | target: err: _ 16 | 17 | dialect-rule: [ 18 | 'fetch set target integer! ( 19 | done: true 20 | either exists? join-of storage target [ 21 | reply message-id to string! read join-of storage target 22 | ][ 23 | reply message-id ajoin [ "Sorry mate, message " target " is not in my store" ] 24 | ] 25 | ) 26 | ] 27 | -------------------------------------------------------------------------------- /commands/introduce-me.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Introduce me - command" 3 | Name: introduce-me-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {introduce me "introduce yourself"} 12 | dialect-rule: [ 13 | ['introduce 'me] (introduce done: true) 14 | ] 15 | 16 | introduce: func [ 17 | /local page username-from-page userid-from-page everyone 18 | ] [ 19 | everyone: copy [] 20 | attempt [ page: to string! read html-url] 21 | parse page [ 22 | thru "initPresent([" 23 | any [ 24 | thru "{id: " copy userid-from-page some id-rule thru {, name: ("} copy username-from-page to {")} 25 | ( trim/all username-from-page 26 | append everyone reduce [username-from-page userid-from-page] 27 | ) 28 | ] 29 | to end 30 | ] probe everyone 31 | speak ajoin [profile-url select everyone user-name "/" url-encode to-dash user-name ] 32 | wait 1 33 | ] 34 | -------------------------------------------------------------------------------- /commands/meaning-of-life-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "What is the meaning of life - command" 3 | Name: meaning-of-life-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {what is the (meaning|purpose) of life? "answers the biggest question of all"} 12 | 13 | dialect-rule: ['what 'is 'the ['meaning | 'purpose] 'of ['life | 'life?] (done: true reply message-id "42")] 14 | -------------------------------------------------------------------------------- /commands/private-session-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Private session with bot - command" 3 | Name: private-session-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {private session [ in ] room-number "Starts a private session with the bot in another room."} 12 | 13 | private-room: _ 14 | 15 | dialect-rule: [ 16 | 'private 'session opt 'in set private-room integer! ( 17 | done: true 18 | attempt [ 19 | reply message-id "OK, coming" 20 | wait 2 21 | speak-private "hello" private-room 22 | ] 23 | ) 24 | ] 25 | -------------------------------------------------------------------------------- /commands/return-a-greeting-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Return a greeting - command" 3 | Name: return-greeting-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {(hi|hello|goodnight|goodbye|bye|[good][night|morning|afternoon|evening]) some-text "returns a greeting to the user who greeted bot"} 12 | 13 | greeting: _ 14 | 15 | dialect-rule: [copy greeting [ 'hello | 'hi | 'goodnight | 'goodbye | 'bye | any 'good [ 'night | 'morning | 'afternoon | 'evening ] ] (reply message-id [greeting " to you too"] done: true)] 16 | -------------------------------------------------------------------------------- /commands/save-my-details-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Save my details - command" 3 | Name: save-my-details-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {save my details url! [ timezone [time!]] "saves your details with url +/- timezone"} 12 | 13 | user-url: user-timezone: _ 14 | 15 | dialect-rule: [ 16 | (print "save rule" 17 | trim/all user-name 18 | ) 19 | 'save 'my 'details set user-url url! ( 20 | add-user-details user-url _ 21 | done: true 22 | ) 23 | any [ set user-timezone time! ] ( 24 | add-user-details user-url user-timezone 25 | done: true 26 | ) 27 | ] 28 | 29 | notable-persons-file: %known-users.r 30 | 31 | was-about-users: [] 32 | 33 | either exists? notable-persons-file [ 34 | about-users: load notable-persons-file 35 | ; check for old style file 36 | if url! = type-of about-users/2 [ 37 | use [tmp tz rec] [ 38 | tmp: copy about-users 39 | clear head about-users 40 | foreach [user url] tmp [ 41 | append about-users user 42 | tz: either rec: select was-about-users user [ 43 | rec/2 44 | ] [_] 45 | repend/only about-users [url tz] 46 | ] 47 | save notable-persons-file about-users 48 | ] 49 | ] 50 | ] [ 51 | about-users: copy was-about-users 52 | ] 53 | 54 | add-user-details: func [user-url timezone [time! blank!] 55 | /local rec person 56 | ] [ 57 | attempt [ 58 | person: to word! user-name 59 | if rec: find about-users person [ 60 | remove/part rec 2 61 | ] 62 | repend about-users person 63 | repend/only about-users [user-url timezone] 64 | save notable-persons-file about-users 65 | reply message-id ajoin ["Added " person "'s details"] 66 | ] 67 | ] 68 | -------------------------------------------------------------------------------- /commands/search-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Search - command" 3 | Name: search-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Date: [ 16-June-2013 21-July-2013 ] 9 | Author: "Graham Chiu" 10 | Options: [private] 11 | ] 12 | 13 | help-string: {search key "retrieves all messages in store that contains key"} 14 | 15 | target: _ 16 | 17 | message-template: {
18 |
19 |
$user_name
20 |
21 |
22 |
$time_stamp
23 |
24 | 25 |
26 | $content 27 |
28 | 29 | 30 |
31 |
32 |
 
33 |
} 34 | 35 | dialect-rule: [ 36 | 'search [set target string! | set target word!] ( 37 | done: true 38 | either any [ 39 | "red" = form target 40 | 3 < length? form target 41 | ] [ 42 | use [json out outstring cnt html filename filepath webroot html-template] [ 43 | webroot: %/var/www/bot-site/html/ 44 | cnt: 0 45 | out: copy [] 46 | html: make string! 1000 47 | outstring: copy "First 50 results^/" 48 | 49 | ?? storage 50 | foreach file sort/reverse read storage [ 51 | if cnt > 50 [ 52 | break 53 | ] 54 | if not dir? file [ 55 | json: load-json to string! read join-of storage file 56 | 57 | if all [ 58 | in json 'content 59 | find json/content form target 60 | ] [ 61 | ++ cnt 62 | repend/only out [json/time_stamp json/user_name json/message_id json/user_id json/content] 63 | ] 64 | ] 65 | ] 66 | either empty? out [ 67 | reply message-id ajoin ["sorry, " target " not found so far"] 68 | ] [ 69 | ; now have all the messages so now construct the content for the html 70 | foreach result out [ 71 | append html reword message-template reduce [ 72 | 'time_stamp from-now unix-to-date result/1 73 | 'user_name result/2 74 | 'message_id result/3 75 | 'user_id result/4 76 | 'content result/5 77 | ] 78 | ] 79 | ; and now create the html - this needs some config 80 | html-template: to string! read join-of webroot %chat-search.html 81 | outstring: reword html-template reduce [ 82 | 'content html 83 | 'number length? out 84 | ] 85 | filepath: rejoin [ webroot filename: join-of checksum to binary! outstring %.html ] 86 | write filepath outstring 87 | 88 | reply message-id ajoin [ {[Query results for } target {](http://www.rebol.info/} filename {)} ] 89 | ] 90 | ] 91 | ] [ 92 | reply message-id "Query string needs to be at least 4 characters" 93 | ] 94 | ) 95 | ] 96 | -------------------------------------------------------------------------------- /commands/send-tweet-command.r3: -------------------------------------------------------------------------------- 1 | Rebol [ 2 | Title: "Twitter command" 3 | Name: twitter-send 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: 12 | {tweet [12345678 | "string"] "Sends tweet of message number or string as @rebolbot"} 13 | 14 | user-id: user-string: text: existing-message-id: _ 15 | twitter-user: "rebolbot" 16 | 17 | room-admins: collect [ 18 | attempt [ 19 | parse to string! read https://chat.stackoverflow.com/rooms/info/291/rebol?tab=access [ 20 | thru
21 | some [ 22 | thru {} 2 skip copy user-string to 24 | (keep reduce [to integer! user-id user-name user-string]) 25 | ] 26 | to end 27 | ] 28 | ] 29 | ] 30 | 31 | dialect-rule: [ 32 | [ 33 | 'tweet [ 34 | set existing-message-id number! ( 35 | either find room-admins person-id [ 36 | ; privileged user 37 | reply message-id join-of "Sending a tweet of message: " existing-message-id 38 | twitter/as twitter-user 39 | twitter/update/override lib/read-message existing-message-id 40 | ] [ 41 | reply message-id ["Sorry, " user-name " you don't have access to send a tweet"] 42 | ] 43 | done: true 44 | ) 45 | | 46 | set text string! ( 47 | either find room-admins person-id [ 48 | ; privileged user 49 | reply message-id join-of "Sending this as a tweet: " text 50 | twitter/as twitter-user 51 | twitter/update/override text 52 | ] [ 53 | reply message-id ["Sorry, " user-name " you don't have access to send a tweet"] 54 | ] 55 | done: true 56 | ) 57 | ] 58 | ] 59 | ] 60 | -------------------------------------------------------------------------------- /commands/show-links-by-user-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Show links by user - command" 3 | Name: show-links-by-user-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {show [ me ][ recent ] links (by|from) user "shows links posted in messages by user"} 12 | 13 | username: _ 14 | 15 | dialect-rule: [ 16 | opt 'show opt 'me opt 'recent 'links ['by | 'from] [set username word! | set username string!] ( 17 | done: true 18 | find-links-by max-scan-messages username 19 | ) 20 | ] 21 | 22 | read-messages-by: func [n username 23 | /local result messages wanted content user 24 | ] [ 25 | wanted: copy [] 26 | username: form username 27 | result: load-json/flat read-messages n 28 | messages: result/2 29 | foreach msg messages [ 30 | if parse msg [some [thru copy content string! | thru copy user string! to end]] [ 31 | if user/1 = username [ 32 | ; found a message we want 33 | append wanted content 34 | ] 35 | ] 36 | ] 37 | wanted 38 | ] 39 | 40 | find-links-by: func [n username 41 | /local result links link ilink text payload 42 | ] [ 43 | links: copy [] 44 | result: read-messages-by n username 45 | ; now have a block of messages by username 46 | ; {this is a link rebol tech that I want to see} 47 | ;["this is a link " "rebol tech" " that I want to see"] 48 | ;{text} 49 | ; [ "text" ] 50 | foreach content result [ 51 | ; grab all links from the message 52 | parse decode 'markup to binary! decode-xml content [ 53 | some [ 54 | opt string! 55 | set link tag! 56 | set text string! 57 | ( 58 | if parse form link [thru {a href="} copy ilink to {"} to end] [ 59 | repend links [text ilink] 60 | ] 61 | ) 62 | opt string! 63 | ] 64 | ] 65 | ] 66 | 67 | ; we have all the links 68 | either empty? links [ 69 | reply message-id ["No links found in the last " n " messages."] 70 | ] [ 71 | payload: rejoin ["In the last " n " messages, " username " posted the following links: "] 72 | foreach [text link] links [ 73 | link: rejoin ["[" text "](" link "); "] 74 | either chat-length-limit < add length? payload length? link [ 75 | reply message-id payload 76 | wait 2 77 | payload: copy link 78 | ] [ 79 | append payload link 80 | ] 81 | ] 82 | reply message-id payload 83 | ] 84 | ] 85 | -------------------------------------------------------------------------------- /commands/show-links-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Show links - command" 3 | Name: show-links-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: 12 | {show (me|all) links [ like url ] "shows saved links (like url, if provided)" 13 | show me your youtube videos "shows saved youtube videos"} 14 | 15 | show-urls: similar: youtube: _ 16 | 17 | dialect-rule: [ 18 | 'show any ['me | 'all] 19 | [ 20 | (show-urls: similar: youtube: false) 21 | 'links (show-urls: true) opt ['like set links url! (similar: true)] | 22 | 'your 'youtube 'videos (youtube: true) 23 | ] (show-selected) 24 | ] 25 | 26 | show-selected: does [ 27 | done: any [similar show-urls youtube] 28 | case [ 29 | similar [ 30 | show-similar-links links 31 | ] 32 | show-urls [ 33 | show-all-links 34 | ] 35 | youtube [ 36 | show-similar-links https://www.youtube.com 37 | wait 2 38 | show-similar-links http://www.youtube.com 39 | ] 40 | ] 41 | 42 | ] 43 | 44 | ; SO chat has a 500 character limit for messages with active links 45 | ; so let's send in 500 ( chat-length-limit ) char chunks 46 | ; this should be a refinement of show-similar-links 47 | show-all-links: func [/local out link used] [ 48 | out: copy "" 49 | used: copy [] 50 | foreach [key data] bot-expressions [ 51 | if not find used data/2 [ 52 | link: ajoin ["[" data/1 "](" data/2 "); "] 53 | either chat-length-limit < add length? out length? link [ 54 | ; over chat-length-limit so send what we have 55 | reply message-id out 56 | wait 2 57 | out: copy link 58 | ] [append out link] 59 | append used data/2 60 | ] 61 | ] 62 | wait 2 63 | if empty? out [out: copy "nothing found"] 64 | reply message-id out 65 | ] 66 | 67 | show-similar-links: func [links /local out link tot used] [ 68 | print "in the simlar links function now" 69 | out: copy "" 70 | used: copy [] 71 | foreach [key data] bot-expressions [ 72 | if not find used data/2 [ 73 | if find/part data/2 links length? links [ 74 | link: ajoin ["[" data/1 "](" data/2 "); "] 75 | ; if adding a new link exceeds allowed, then send current 76 | either chat-length-limit < tot: add length? out length? link [ 77 | reply message-id out 78 | wait 2 79 | ; and reset out to the new link 80 | out: copy link 81 | ] [ 82 | append out link 83 | ] 84 | append used data/2 85 | ] 86 | ] 87 | ] 88 | wait 2 89 | ;?? out 90 | if empty? out [out: copy "nothing found"] 91 | reply message-id out 92 | ] 93 | -------------------------------------------------------------------------------- /commands/shut-up-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Shut up" 3 | Name: shut-up 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [ 8 | bot-api 1.0.0 9 | ] 10 | Options: [private] 11 | ] 12 | 13 | help-string: {shut up "Allows room users to kill the bot"} 14 | 15 | dialect-rule: [ 16 | 'shut 'up ( 17 | quit/with 42 18 | ) 19 | ] 20 | -------------------------------------------------------------------------------- /commands/source-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Source for a Rebol or Bot function - command" 3 | Name: source-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Date: 13-June-2013 9 | Author: "Graham Chiu & Andreas" 10 | Options: [private] 11 | ] 12 | 13 | help-string: {source name "provides Rebol source for named function"} 14 | 15 | target: err: _ 16 | 17 | dialect-rule: [ 18 | 'source set target word! ( 19 | done: true 20 | either target = 'bot-config [ 21 | reply message-id "You need to use your own config file!" 22 | ][ 23 | if error? set/any 'err try [ 24 | speak to-markdown-code rejoin [target ": " mold get bind target lib] 25 | ][ 26 | if error? try [ 27 | speak to-markdown-code rejoin [target ": " mold get bind target self] 28 | ][ 29 | reply message-id ajoin [ "Sorry, " target " is not in my vocab!" ] 30 | ] 31 | ] 32 | ] 33 | ) 34 | ] 35 | 36 | -------------------------------------------------------------------------------- /commands/tag-handling-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Tag handling - command" 3 | Name: tag-handling-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: 12 | {save key [string! word!] description [string!] link [url!] "save key with description and link" 13 | keys "returns known keys" 14 | remove key "removes key (requires authorized user)" 15 | find descript [string! word!] "shows keys with description containing descript"} 16 | 17 | expression: findstring: _ 18 | 19 | dialect-rule: [ 20 | ; save-key-rule 21 | ['save not [ 'my ] copy expression to end (done: true save-key expression)] | 22 | ; list keys 23 | ['keys (done: true show-keys)] | 24 | ; remove-key-rule 25 | [ 26 | 'remove copy expression to end ( 27 | done: true 28 | remove-key form expression 29 | ) 30 | ] | 31 | ; find-string-rule 32 | [ 33 | 'find [set findstring string! | set findstring word!] ( 34 | done: true 35 | find-in-links form findstring 36 | ) 37 | ] 38 | ] 39 | 40 | ;; The file to which expressions are persisted across bot startup/shutdown 41 | expressions: %bot-expressions.r 42 | 43 | ; save expressions bot-expressions 44 | 45 | if exists? expressions [ 46 | bot-expressions: load expressions 47 | ] 48 | 49 | save-key: func [content [string! block!] /local exp err] [ 50 | if error? err: try [ 51 | exp: to block! content 52 | ?? exp 53 | either all [ 54 | any [string? exp/1 word? exp/1] 55 | exp/1: trim to string! exp/1 56 | 3 <= length? exp/1 ; no keywords of 1 2 characters 57 | string? exp/2 58 | url? exp/3 59 | ] [ 60 | print "okay to add" 61 | either not find bot-expressions exp/1 [ 62 | print "adding" 63 | append bot-expressions exp/1 64 | repend/only bot-expressions [exp/2 exp/3] 65 | save expressions bot-expressions 66 | reply message-id ["added key: " exp/1] 67 | ] [ 68 | reply message-id [exp/1 " is already a key"] 69 | ] 70 | ] [ 71 | reply message-id [content " can not be saved as key"] 72 | ] 73 | ] [ 74 | probe mold err 75 | reply message-id mold err 76 | ] 77 | ] 78 | 79 | show-keys: func [/local tmp out] [ 80 | tmp: copy [] out: copy "" 81 | foreach [key data] bot-expressions [ 82 | repend tmp [key data/1] 83 | ] 84 | sort/skip tmp 2 85 | foreach [key description] tmp [ 86 | repend out ajoin [key { "} description {"^/}] 87 | ] 88 | reply message-id compose ["I know the following keys: ^/" (out)] 89 | ] 90 | 91 | remove-key: func [content 92 | /local rec 93 | ] [ 94 | either find privileged-users person-id [ 95 | ; privileged user 96 | either rec: find bot-expressions content [ 97 | remove/part rec 2 98 | save expressions bot-expressions 99 | reply message-id ["removed " content] 100 | ] [ 101 | reply message-id [content " not found in my keys"] 102 | ] 103 | ] [ 104 | reply message-id ["Sorry, " user-name " you don't have the privileges yet to remove the key " content] 105 | ] 106 | ] 107 | 108 | find-in-links: func [findstring 109 | /local out used link 110 | ] [ 111 | either 3 > length? findstring [ 112 | reply message-id "Find string needs to be at least 3 characters" 113 | ] [ 114 | out: copy "" 115 | used: copy [] 116 | foreach [key data] bot-expressions [ 117 | if all [ 118 | not find used data/2 119 | find data/1 findstring 120 | ] [ 121 | link: ajoin ["[" data/1 "](" data/2 "); "] 122 | either chat-length-limit < add length? out length? link [ 123 | reply message-id out 124 | wait 2 125 | out: copy link 126 | ] [ 127 | append out link 128 | ] 129 | append used data/2 130 | ] 131 | ] 132 | if empty? out [out: copy "nothing found"] 133 | reply message-id out 134 | ] 135 | ] 136 | -------------------------------------------------------------------------------- /commands/what-is-time-relative-to-gmt-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "What is current time relative to GMT? - command" 3 | Name: what-is-time-relative-to-gmt-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {what is the time?} 12 | 13 | dialect-rule: ['what 'is 'the ['time | 'time?] opt ['now? | 'now | 'in 'GMT] (done: true reply-time)] 14 | 15 | reply-time: func [] [reply message-id to-idate now] 16 | -------------------------------------------------------------------------------- /commands/who-do-you-know-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Who do you know? - command" 3 | Name: who-do-you-know-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {who do you know "returns a list of all known users"} 12 | 13 | dialect-rule: ['who 'do 'you ['know | 'know?] (show-all-users done: true)] 14 | 15 | show-all-users: func [ 16 | /local tmp 17 | ] [ 18 | tmp: copy [] 19 | foreach [user address] about-users [ 20 | append tmp user 21 | ] 22 | reply message-id join-of "I know something of the following people: " form sort tmp 23 | ] 24 | -------------------------------------------------------------------------------- /commands/who-is-online-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Who is online? - command" 3 | Name: who-is-online-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.1 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {present[?] "prints users currently online"} 12 | dialect-rule: [['present | 'present?] (done: true who-is-online)] 13 | 14 | ;; The implementation in this module is specific to SO chat. When the specific chat 15 | ;; connectivity is factored out into its own module, this code should be changed to 16 | ;; delegate to the chat module being used. Note that it is conceivable that one bot 17 | ;; instance could manage multiple chat rooms/systems. 18 | 19 | ;; Where to save the chat visitors 20 | visitors-file: %visitors.r 21 | visitors: copy [] 22 | 23 | ;; Compile a list of known people 24 | either not exists? visitors-file [ 25 | foreach [user data] about-users [ 26 | append visitors form user 27 | ] 28 | save visitors-file visitors 29 | ] [ 30 | visitors: load visitors-file 31 | ] 32 | 33 | ;; Scan the html page, check to see who is here, and send a greet message to new users 34 | who-is-online: func [ 35 | /silent 36 | /local out page username userid len newbies addressees reputation full-greet-message err json-name 37 | ] [ 38 | addressees: copy "" 39 | len: length? visitors 40 | out: copy [] 41 | newbies: copy [] 42 | reputation: copy "" 43 | page: to string! read html-url 44 | parse page [ 45 | any [ 46 | thru "update_user({id: " copy userid some id-rule thru {, name: (} copy username to {)} 47 | thru "reputation: " copy reputation to "," thru "});" 48 | (trim/all username 49 | print [ "rep: " reputation userid username] 50 | json-name: copy username 51 | username: load-json username 52 | append out username 53 | if not find visitors username [ 54 | append visitors copy username 55 | repend/only newbies [trim/with json-name {"} username userid to-integer reputation] 56 | ] 57 | ) 58 | ] 59 | to end 60 | ] 61 | either empty? out [ 62 | ; this floods the room with can not parse the page messages! 63 | ; reply message-id "can not parse the page for users" 64 | ] [ 65 | either not silent [ 66 | reply message-id form out 67 | ] [ 68 | ; silent scan has detected new users - so let's greet them 69 | if not empty? newbies [ 70 | foreach person newbies [ 71 | ;;append addressees ajoin [ "@" person " " ] 72 | full-greet-message: copy greet-message 73 | if error? set/any 'err try [ 74 | either 20 > person/4 [ 75 | append full-greet-message low-rep-message 76 | ] [ 77 | speak ajoin [profile-url person/3 "/" url-encode to-dash person/2] 78 | ; Modified following SO discussion about bots not speaking unless spoken to 79 | speak full-greet-message 80 | ] 81 | ] [ 82 | log mold err 83 | ] 84 | ;speak ajoin ["@" person/2 " " full-greet-message] 85 | wait 1 86 | ] 87 | ] 88 | ] 89 | if len < length? visitors [ 90 | save visitors-file visitors 91 | ] 92 | ] 93 | ] 94 | 95 | pulse-callback: does [who-is-online/silent 0] 96 | -------------------------------------------------------------------------------- /commands/who-is-user-command.r3: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Who is user? - command" 3 | Name: who-is-user-command 4 | Type: module 5 | Role: command 6 | Version: 1.0.0 7 | Needs: [bot-api 1.0.0] 8 | Options: [private] 9 | ] 10 | 11 | help-string: {who is user "returns user details and page"} 12 | 13 | user: _ 14 | 15 | dialect-rule: [ 16 | [some ['who 'is | 'whois | 'who 'the 'dickens 'is] copy user to end 17 | ] (if found? user [show-user-page user/1] done: true) 18 | ] 19 | 20 | ; user-name is the one asking the question 21 | show-user-page: func [user /local data known timezone gmt err userid] [ 22 | gmt: now 23 | gmt/zone: 0:00 24 | gmt: gmt - now/zone 25 | known: false 26 | user: to string! user 27 | attempt [trim/all user-name known: find ?? about-users to word! user-name] 28 | if #"?" = last user [remove back tail user] 29 | if error? set/any 'err try [ 30 | either data: select about-users to word! user [ 31 | reply message-id ajoin [ 32 | "I know this about [" user "](" data/1 ") and their local time is " 33 | either time? timezone: data/2 [gmt + timezone] [ 34 | "unknown." 35 | ] 36 | ] 37 | ] [ 38 | reply message-id ["Sorry, I don't know anything about " user " yet. But ..."] 39 | userid: get-userid user 40 | either integer? userid [ ; userid: get-userid user [ 41 | wait 2 42 | speak ajoin [ profile-url userid "/" url-encode to-dash user] 43 | ][ 44 | log ajoin [ "Type? " type-of userid " of " userid ] 45 | ] 46 | ] 47 | if not known [ 48 | reply message-id ["I'd like to know about you! Use the 'save my details' command"] 49 | ] 50 | ] [ 51 | probe err 52 | ] 53 | ] 54 | -------------------------------------------------------------------------------- /prot-http.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | System: "REBOL [R3] Language Interpreter and Run-time Environment" 3 | Title: "REBOL 3 HTTP protocol scheme" 4 | Rights: { 5 | Copyright 2012 REBOL Technologies 6 | REBOL is a trademark of REBOL Technologies 7 | } 8 | License: { 9 | Licensed under the Apache License, Version 2.0 10 | See: http://www.apache.org/licenses/LICENSE-2.0 11 | } 12 | Name: 'http 13 | Type: 'module 14 | Version: 0.1.0 15 | File: %prot-http.r 16 | Purpose: { 17 | This program defines the HTTP protocol scheme for REBOL 3. 18 | } 19 | Author: "Gabriele Santilli" 20 | Date: 22-Jun-2007 21 | ] 22 | 23 | sync-op: func [port body /local state] [ 24 | unless port/state [open port port/state/close?: yes] 25 | state: port/state 26 | state/awake: :read-sync-awake 27 | do body 28 | if state/state = 'ready [do-request port] 29 | unless port? wait [state/connection port/spec/timeout] [http-error "Timeout"] 30 | body: copy port 31 | if all [ 32 | select state/info/headers 'Content-Type 33 | state/info/headers/Content-Type 34 | parse state/info/headers/Content-Type [ 35 | "text/" thru "; charset=UTF-8" 36 | ] 37 | ] [ 38 | body: to string! body 39 | ] 40 | if state/close? [close port] 41 | body 42 | ] 43 | read-sync-awake: func [event [event!] /local error] [ 44 | switch/default event/type [ 45 | connect ready [ 46 | do-request event/port 47 | false 48 | ] 49 | done [ 50 | true 51 | ] 52 | close [ 53 | true 54 | ] 55 | error [ 56 | error: event/port/state/error 57 | event/port/state/error: none 58 | do error 59 | ] 60 | ] [ 61 | false 62 | ] 63 | ] 64 | http-awake: func [event /local port http-port state awake res] [ 65 | port: event/port 66 | http-port: port/locals 67 | state: http-port/state 68 | if any-function? :http-port/awake [state/awake: :http-port/awake] 69 | awake: :state/awake 70 | switch/default event/type [ 71 | read [ 72 | awake make event! [type: 'read port: http-port] 73 | check-response http-port 74 | ] 75 | wrote [ 76 | awake make event! [type: 'wrote port: http-port] 77 | state/state: 'reading-headers 78 | read port 79 | false 80 | ] 81 | lookup [open port false] 82 | connect [ 83 | state/state: 'ready 84 | awake make event! [type: 'connect port: http-port] 85 | ] 86 | close [ 87 | res: switch state/state [ 88 | ready [ 89 | awake make event! [type: 'close port: http-port] 90 | ] 91 | doing-request reading-headers [ 92 | state/error: make-http-error "Server closed connection" 93 | awake make event! [type: 'error port: http-port] 94 | ] 95 | reading-data [ 96 | either any [integer? state/info/headers/content-length state/info/headers/transfer-encoding = "chunked"] [ 97 | state/error: make-http-error "Server closed connection" 98 | awake make event! [type: 'error port: http-port] 99 | ] [ 100 | any [ 101 | awake make event! [type: 'done port: http-port] 102 | awake make event! [type: 'close port: http-port] 103 | ] 104 | ] 105 | ] 106 | ] 107 | close http-port 108 | res 109 | ] 110 | ] [true] 111 | ] 112 | make-http-error: func [ 113 | "Make an error for the HTTP protocol" 114 | message [string! block!] 115 | ] [ 116 | if block? message [message: ajoin message] 117 | make error! [ 118 | type: 'Access 119 | id: 'Protocol 120 | arg1: message 121 | ] 122 | ] 123 | http-error: func [ 124 | "Throw an error for the HTTP protocol" 125 | message [string! block!] 126 | ] [ 127 | do make-http-error message 128 | ] 129 | make-http-request: func [ 130 | "Create an HTTP request (returns string!)" 131 | method [word! string!] "E.g. GET, HEAD, POST etc." 132 | target [file! string!] {In case of string!, no escaping is performed (eg. useful to override escaping etc.). Careful!} 133 | headers [block!] "Request headers (set-word! string! pairs)" 134 | content [any-string! binary! blank!] {Request contents (Content-Length is created automatically). Empty string not exactly like none.} 135 | /local result 136 | ] [ 137 | result: rejoin [ 138 | uppercase form method #" " 139 | either file? target [next mold target] [target] 140 | " HTTP/1.0" CRLF 141 | ] 142 | foreach [word string] headers [ 143 | repend result [mold word #" " string CRLF] 144 | ] 145 | if content [ 146 | content: to binary! content 147 | repend result ["Content-Length: " length? content CRLF] 148 | ] 149 | append result CRLF 150 | result: to binary! result 151 | if content [append result content] 152 | result 153 | ] 154 | do-request: func [ 155 | "Perform an HTTP request" 156 | port [port!] 157 | /local spec info 158 | ] [ 159 | spec: port/spec 160 | info: port/state/info 161 | spec/headers: body-of make make object! [ 162 | Accept: "*/*" 163 | Accept-Charset: "utf-8" 164 | Host: either spec/port-id <> 80 [ 165 | rejoin [form spec/host #":" spec/port-id] 166 | ] [ 167 | form spec/host 168 | ] 169 | User-Agent: "REBOL" 170 | ] spec/headers 171 | port/state/state: 'doing-request 172 | info/headers: info/response-line: info/response-parsed: port/data: 173 | info/size: info/date: info/name: none 174 | write port/state/connection 175 | make-http-request spec/method to file! any [spec/path %/] 176 | spec/headers spec/content 177 | ] 178 | parse-write-dialect: func [port block /local spec] [ 179 | spec: port/spec 180 | parse block [[set block word! (spec/method: block) | (spec/method: 'post)] 181 | opt [set block [file! | url!] (spec/path: block)] [set block block! (spec/headers: block) | (spec/headers: [])] [set block [any-string! | binary!] (spec/content: block) | (spec/content: none)] 182 | ] 183 | ] 184 | check-response: func [port /local conn res headers d1 d2 line info state awake spec] [ 185 | state: port/state 186 | conn: state/connection 187 | info: state/info 188 | headers: info/headers 189 | line: info/response-line 190 | awake: :state/awake 191 | spec: port/spec 192 | if all [ 193 | not headers 194 | d1: find conn/data crlfbin 195 | d2: find/tail d1 crlf2bin 196 | ] [ 197 | info/response-line: line: to string! copy/part conn/data d1 198 | info/headers: headers: construct/with d1 http-response-headers 199 | info/name: to file! any [spec/path %/] 200 | if headers/content-length [info/size: headers/content-length: to integer! headers/content-length] 201 | if headers/last-modified [info/date: attempt [to date! headers/last-modified]] 202 | remove/part conn/data d2 203 | state/state: 'reading-data 204 | ] 205 | unless headers [ 206 | read conn 207 | return false 208 | ] 209 | res: false 210 | unless info/response-parsed [ 211 | ;?? line 212 | parse/all line [ 213 | "HTTP/1." [#"0" | #"1"] some #" " [ 214 | #"1" (info/response-parsed: 'info) 215 | | 216 | #"2" [["04" | "05"] (info/response-parsed: 'no-content) 217 | | (info/response-parsed: 'ok) 218 | ] 219 | | 220 | #"3" [ 221 | "03" (info/response-parsed: 'see-other) 222 | | 223 | "04" (info/response-parsed: 'not-modified) 224 | | 225 | "05" (info/response-parsed: 'use-proxy) 226 | | (info/response-parsed: 'redirect) 227 | ] 228 | | 229 | #"4" [ 230 | "01" (info/response-parsed: 'unauthorized) 231 | | 232 | "07" (info/response-parsed: 'proxy-auth) 233 | | (info/response-parsed: 'client-error) 234 | ] 235 | | 236 | #"5" (info/response-parsed: 'server-error) 237 | ] 238 | | (info/response-parsed: 'version-not-supported) 239 | ] 240 | ] 241 | switch/all info/response-parsed [ 242 | ok [ 243 | either spec/method = 'head [ 244 | state/state: 'ready 245 | res: awake make event! [type: 'done port: port] 246 | unless res [res: awake make event! [type: 'ready port: port]] 247 | ] [ 248 | res: check-data port 249 | if all [not res state/state = 'ready] [ 250 | res: awake make event! [type: 'done port: port] 251 | unless res [res: awake make event! [type: 'ready port: port]] 252 | ] 253 | ] 254 | ] 255 | redirect see-other [ 256 | either spec/method = 'head [ 257 | state/state: 'ready 258 | res: awake make event! [type: 'custom port: port code: 0] 259 | ] [ 260 | res: check-data port 261 | ] 262 | if all [not res state/state = 'ready] [ 263 | either all [ 264 | any [ 265 | find [get head] spec/method 266 | all [ 267 | info/response-parsed = 'see-other 268 | spec/method: 'get 269 | ] 270 | ] 271 | in headers 'Location 272 | ] [ 273 | res: do-redirect port headers/location 274 | ] [ 275 | state/error: make-http-error "Redirect requires manual intervention" 276 | res: awake make event! [type: 'error port: port] 277 | ] 278 | ] 279 | ] 280 | unauthorized client-error server-error proxy-auth [ 281 | either spec/method = 'head [ 282 | state/state: 'ready 283 | ] [ 284 | check-data port 285 | ] 286 | ] 287 | unauthorized [ 288 | state/error: make-http-error "Authentication not supported yet" 289 | res: awake make event! [type: 'error port: port] 290 | ] 291 | client-error server-error [ 292 | state/error: make-http-error ["Server error: " line] 293 | res: awake make event! [type: 'error port: port] 294 | ] 295 | not-modified [state/state: 'ready 296 | res: awake make event! [type: 'done port: port] 297 | unless res [res: awake make event! [type: 'ready port: port]] 298 | ] 299 | use-proxy [ 300 | state/state: 'ready 301 | state/error: make-http-error "Proxies not supported yet" 302 | res: awake make event! [type: 'error port: port] 303 | ] 304 | proxy-auth [ 305 | state/error: make-http-error "Authentication and proxies not supported yet" 306 | res: awake make event! [type: 'error port: port] 307 | ] 308 | no-content [ 309 | state/state: 'ready 310 | res: awake make event! [type: 'done port: port] 311 | unless res [res: awake make event! [type: 'ready port: port]] 312 | ] 313 | info [ 314 | info/headers: info/response-line: info/response-parsed: port/data: none 315 | state/state: 'reading-headers 316 | read conn 317 | ] 318 | version-not-supported [ 319 | state/error: make-http-error "HTTP response version not supported" 320 | res: awake make event! [type: 'error port: port] 321 | close port 322 | ] 323 | ] 324 | res 325 | ] 326 | crlfbin: #{0D0A} 327 | crlf2bin: #{0D0A0D0A} 328 | crlf2: to string! crlf2bin 329 | http-response-headers: context [ 330 | Content-Length: 331 | Transfer-Encoding: 332 | Last-Modified: none 333 | ] 334 | do-redirect: func [port [port!] new-uri [url! string! file!] /local spec state] [ 335 | spec: port/spec 336 | state: port/state 337 | if #"/" = first new-uri [ 338 | new-uri: to url! ajoin [spec/scheme "://" spec/host new-uri] 339 | ] 340 | new-uri: construct/with decode-url new-uri port/scheme/spec 341 | if new-uri/scheme <> 'http [ 342 | state/error: make-http-error {Redirect to a protocol different from HTTP not supported} 343 | return state/awake make event! [type: 'error port: port] 344 | ] 345 | either all [ 346 | new-uri/host = spec/host 347 | new-uri/port-id = spec/port-id 348 | ] [ 349 | spec/path: new-uri/path 350 | do-request port 351 | false 352 | ] [ 353 | state/error: make-http-error "Redirect to other host - requires custom handling" 354 | state/awake make event! [type: 'error port: port] 355 | ] 356 | ] 357 | check-data: func [port /local headers res data out chunk-size mk1 mk2 trailer state conn] [ 358 | state: port/state 359 | headers: state/info/headers 360 | conn: state/connection 361 | res: false 362 | case [ 363 | headers/transfer-encoding = "chunked" [ 364 | data: conn/data 365 | out: port/data: make binary! length? data 366 | until [ 367 | either parse/all data [ 368 | copy chunk-size some hex-digits thru crlfbin mk1: to end 369 | ] [ 370 | chunk-size: to integer! to issue! chunk-size 371 | either chunk-size = 0 [ 372 | if parse/all mk1 [ 373 | crlfbin (trailer: "") to end | copy trailer to crlf2bin to end 374 | ] [ 375 | trailer: construct trailer 376 | append headers body-of trailer 377 | state/state: 'ready 378 | res: state/awake make event! [type: 'custom port: port code: 0] 379 | clear data 380 | ] 381 | true 382 | ] [ 383 | either parse/all mk1 [ 384 | chunk-size skip mk2: crlfbin to end 385 | ] [ 386 | insert/part tail out mk1 mk2 387 | remove/part data skip mk2 2 388 | empty? data 389 | ] [ 390 | true 391 | ] 392 | ] 393 | ] [ 394 | true 395 | ] 396 | ] 397 | unless state/state = 'ready [read conn] 398 | ] 399 | integer? headers/content-length [ 400 | port/data: conn/data 401 | either headers/content-length <= length? port/data [ 402 | state/state: 'ready 403 | conn/data: make binary! 32000 404 | res: state/awake make event! [type: 'custom port: port code: 0] 405 | ] [ 406 | read conn 407 | ] 408 | ] 409 | true [ 410 | port/data: conn/data 411 | read conn 412 | ] 413 | ] 414 | res 415 | ] 416 | hex-digits: charset "1234567890abcdefABCDEF" 417 | sys/make-scheme [ 418 | name: 'http 419 | title: "HyperText Transport Protocol v1.1" 420 | spec: make system/standard/port-spec-net [ 421 | path: %/ 422 | method: 'get 423 | headers: [] 424 | content: none 425 | timeout: 15 426 | ] 427 | info: make system/standard/file-info [ 428 | response-line: 429 | response-parsed: 430 | headers: none 431 | ] 432 | actor: [ 433 | read: func [ 434 | port [port!] 435 | ] [ 436 | either any-function? :port/awake [ 437 | unless open? port [cause-error 'Access 'not-open port/spec/ref] 438 | if port/state/state <> 'ready [http-error "Port not ready"] 439 | port/state/awake: :port/awake 440 | do-request port 441 | port 442 | ] [ 443 | sync-op port [] 444 | ] 445 | ] 446 | write: func [ 447 | port [port!] 448 | value 449 | ] [ 450 | unless any [block? :value binary? :value any-string? :value] [value: form :value] 451 | unless block? value [value: reduce [[Content-Type: "application/x-www-form-urlencoded; charset=utf-8"] value]] 452 | either any-function? :port/awake [ 453 | unless open? port [cause-error 'Access 'not-open port/spec/ref] 454 | if port/state/state <> 'ready [http-error "Port not ready"] 455 | port/state/awake: :port/awake 456 | parse-write-dialect port value 457 | do-request port 458 | port 459 | ] [ 460 | sync-op port [parse-write-dialect port value] 461 | ] 462 | ] 463 | open: func [ 464 | port [port!] 465 | /local conn 466 | ] [ 467 | if port/state [return port] 468 | if none? port/spec/host [http-error "Missing host address"] 469 | port/state: context [ 470 | state: 'inited 471 | connection: 472 | error: none 473 | close?: no 474 | info: make port/scheme/info [type: 'file] 475 | awake: :port/awake 476 | ] 477 | port/state/connection: conn: make port! [ 478 | scheme: 'tcp 479 | host: port/spec/host 480 | port-id: port/spec/port-id 481 | ref: rejoin [tcp:// host ":" port-id] 482 | ] 483 | conn/awake: :http-awake 484 | conn/locals: port 485 | open conn 486 | port 487 | ] 488 | open?: func [ 489 | port [port!] 490 | ] [ 491 | found? all [port/state open? port/state/connection] 492 | ] 493 | close: func [ 494 | port [port!] 495 | ] [ 496 | if port/state [ 497 | close port/state/connection 498 | port/state/connection/awake: none 499 | port/state: none 500 | ] 501 | port 502 | ] 503 | copy: func [ 504 | port [port!] 505 | ] [ 506 | either all [port/spec/method = 'head port/state] [ 507 | reduce bind [name size date] port/state/info 508 | ] [ 509 | if port/data [copy port/data] 510 | ] 511 | ] 512 | query: func [ 513 | port [port!] 514 | /local error state 515 | ] [ 516 | if state: port/state [ 517 | either error? error: state/error [ 518 | state/error: none 519 | error 520 | ] [ 521 | state/info 522 | ] 523 | ] 524 | ] 525 | length?: func [ 526 | port [port!] 527 | ] [ 528 | either port/data [length? port/data] [0] 529 | ] 530 | ] 531 | ] 532 | -------------------------------------------------------------------------------- /rebolbot.r3: -------------------------------------------------------------------------------- 1 | Rebol [ 2 | file: %rebolbot.r3 3 | author: ["Graham Chiu" "Adrian Sampaleanu" "John Kenyon"] 4 | date: [28-Feb-2013 11-Apr-2013 2-June-2013 20-June-2013 20-July-2013 25-Mar-2014 13-May-2015 16-May-2017] ; leave this as a block plz! It's used by version command 5 | version: 0.1.5 6 | purpose: {Perform useful, automated actions in Stackoverflow chat rooms} 7 | License: 'Apache2 8 | Notes: {16-May-2017 first attempt to update to ren-c} 9 | Needs: [ 10 | ; %twitter.r3 11 | ;%bot-api.r3 f 12 | ;%altwebform.reb 13 | ;%prot-http.r3 ;required for login2so functino 14 | ;http://reb4.me/r3/altjson 15 | ;http://reb4.me/r3/altwebform 16 | ; http://reb4.me/r3/altxml 17 | ] 18 | ] 19 | do %bot-api.r3 20 | import ; %webform.reb 21 | import 22 | import 23 | ; do/args %twitter-config.r3 24 | 25 | system/options/default-suffix: %.r3 26 | command-dir: %commands/ 27 | 28 | sync-commands: func [ /local cmd-header err ] [ 29 | lib/commands: copy [] 30 | for-each command read command-dir [ 31 | if error? err: trap [ 32 | if all [ 33 | system/options/default-suffix = suffix? command 34 | cmd-header: load/header join-of command-dir command 35 | find cmd-header/1/Needs 'bot-api 36 | cmd-header/1/Role = 'command 37 | ][ 38 | append lib/commands cmd: import/no-lib rejoin [command-dir command] 39 | ] 40 | ][ 41 | probe err 42 | ] 43 | ] 44 | ] 45 | 46 | sync-commands 47 | 48 | if not set? 'shrink [ 49 | shrink: load %shrink.reb ; https://raw.githubusercontent.com/gchiu/rebolbot/master/shrink.reb 50 | eliza: make object! shrink/4 51 | eliza/rules: shrink/6 52 | ] 53 | 54 | lib/chat-length-limit: 500 ; SO chat limits to 500 chars if a message contains a link 55 | 56 | ; config botname - e.g. @MyBot 57 | either exists? %bot-config.r [ 58 | bot-config: object load %bot-config.r 59 | lib/botname: bot-config/botname 60 | room-id: bot-config/room-id 61 | room-descriptor: bot-config/room-descriptor 62 | lib/greet-message: bot-config/greet-message 63 | lib/low-rep-message: bot-config/low-rep-message 64 | bot-user: bot-config/bot-user 65 | bot-pass: bot-config/bot-pass 66 | 67 | ; dump bot-config 68 | ; don't know the credentials 69 | ; lib/ideone-user: bot-config/ideone-user 70 | ; lib/ideone-pass: bot-config/ideone-pass 71 | ; lib/ideone-url: bot-config/ideone-url 72 | log-file: bot-config/log-file 73 | ] [ 74 | lib/botname: "-- name me --" 75 | room-id: 0 76 | room-descriptor: "-- room name --" 77 | lib/greet-message: "-- set my welcome message --" 78 | lib/low-rep-message: "-- set my low reputation message --" 79 | lib/ideone-user: "-- get your own --" 80 | lib/ideone-pass: "-- get your own --" 81 | lib/ideone-url: http://apiurl 82 | log-file: %log.txt 83 | ] 84 | 85 | ; put this into bot-config 86 | lib/storage: %messages/ 87 | if not exists? lib/storage [ 88 | make-dir lib/storage 89 | ] 90 | 91 | ; write %bot-config.r compose [ 92 | ; botname: (mold lib/botname) #"^/" 93 | ; room-id: (room-id) #"^/" 94 | ; room-descriptor: (mold room-descriptor) #"^/" 95 | ; greet-message: (mold lib/greet-message) #"^/" 96 | ; ] 97 | 98 | lib/pause-period: 5 ; 5 seconds between each poll of the chat 99 | lib/no-of-messages: 5 ; fetch 5 messages each time 100 | lib/max-scan-messages: 200 ; max to fetch to scan for links by a user 101 | 102 | ; these users can remove keys - uses userids, the names are there just so that you know who they are! 103 | lib/privileged-users: ["HostileFork" 211160 "Graham Chiu" 76852 "johnk" 1864998] 104 | 105 | orders-cache: copy [ ] 106 | cache-size: 6 107 | ; we have a cache of 6 orders to the bot - [ message-id [integer!] order [string!] ] 108 | append/dup orders-cache _ cache-size * 2 109 | 110 | lastmessage-no: 8743137 111 | last-message-file: %lastmessage-no.r 112 | 113 | if exists? last-message-file [ 114 | attempt [ 115 | lastmessage-no: load last-message-file 116 | ] 117 | ] 118 | 119 | dump lastmessage-no 120 | 121 | so-chat-url: http://chat.stackoverflow.com/ 122 | lib/profile-url: http://stackoverflow.com/users/ 123 | chat-target-url: rejoin write-chat-block: [so-chat-url 'chats "/" room-id "/" 'messages/new] 124 | lib/referrer-url: rejoin [so-chat-url 'rooms "/" room-id "/" room-descriptor] 125 | lib/html-url: rejoin [lib/referrer-url "?highlights=false"] 126 | read-target-url: rejoin [so-chat-url 'chats "/" room-id "/" 'events] 127 | read-message-target-url: rejoin [so-chat-url 'message] 128 | delete-url: [so-chat-url 'messages "/" (lib/parent-id) "/" 'delete] 129 | 130 | lib/id-rule: charset [#"0" - #"9"] 131 | non-space: complement space: charset #" " 132 | 133 | lib/unix-to-date: func [ unix [string! integer!] 134 | /local days d 135 | ][ 136 | if string? unix [ unix: to integer! unix ] 137 | days: unix / 24 / 60 / 60 138 | d: 1-Jan-1970 + days 139 | d/zone: 0:00 140 | d/second: 0 141 | d 142 | ] 143 | 144 | lib/from-now: func [ d [date!]][ 145 | case [ 146 | d + 7 < now [ d ] 147 | d + 1 < now [ join-of now - d " days ago" ] 148 | d + 1:00 < now [ join-of to integer! divide difference now d 1:00 " hours ago" ] 149 | d + 0:1:00 < now [ join-of to integer! divide difference now d 0:1:00 " minutes ago" ] 150 | true [ join-of to integer! divide now/time - d/time 0:0:1 " seconds ago" ] 151 | ] 152 | ] 153 | 154 | lib/unix-now: does [ 155 | 60 * 60 * divide difference now/utc 1-Jan-1970 1:00 156 | ] 157 | 158 | lib/two-minutes-ago: does [ 159 | subtract lib/unix-now 60 * 2 160 | ] 161 | 162 | lib/percent-encode: func [char [char!]] [ 163 | char: enbase/base to-binary char 16 164 | parse char [ 165 | copy char some [char: 2 skip (insert char "%") skip] 166 | ] 167 | char 168 | ] 169 | 170 | ; why aren't we use the url-encode from webform? 171 | lib/url-encode: use [ch mk] [ 172 | ch: charset ["-." #"0" - #"9" #"A" - #"Z" #"-" #"a" - #"z" #"~"] 173 | func [text [any-string!]] [ 174 | either parse text: form text [ 175 | any [ 176 | some ch | end | change " " "+" | 177 | mk: (mk: lib/percent-encode mk/1) 178 | change skip mk 179 | ] 180 | ] [to-string text] [""] 181 | ] 182 | ] 183 | 184 | ; updated to remove the /local pad 185 | lib/to-itime: func [ 186 | {Returns a standard internet time string (two digits for each segment)} 187 | time [time! number! block! blank!] 188 | ] [ 189 | time: make time! time 190 | rejoin [ 191 | next form 100 + time/hour ":" 192 | next form 100 + time/minute ":" 193 | next form 100 + round/down time/second 194 | ] 195 | ] 196 | 197 | lib/to-idate: func [ 198 | "Returns a standard Internet date string." 199 | date [date!] 200 | /local str 201 | ] [ 202 | str: form date/zone 203 | remove find str ":" 204 | if (first str) <> #"-" [insert str #"+"] 205 | if (length? str) <= 4 [insert next str #"0"] 206 | reform [ 207 | pick ["Mon," "Tue," "Wed," "Thu," "Fri," "Sat," "Sun,"] date/weekday 208 | date/day 209 | pick ["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] date/month 210 | date/year 211 | lib/to-itime any [date/time 0:00] 212 | str 213 | ] 214 | ] 215 | 216 | lib/to-markdown-code: func [ txt /local out something ][ 217 | quadspace: " " 218 | out: copy "" ; copy quadspace 219 | parse txt [ 220 | some [ 221 | copy something to newline newline ( 222 | append out join-of quadspace something 223 | append out newline 224 | ) 225 | | 226 | copy something to end ( 227 | append out quadspace 228 | append out something 229 | ) 230 | ] 231 | ] 232 | print out 233 | trim/tail out 234 | ] 235 | 236 | lib/to-dash: func [ username ][ 237 | foreach c " ." [ 238 | replace/all username c "-" 239 | ] 240 | username 241 | ] 242 | cookie-jar: make map! [] 243 | 244 | find-all-cookies: function [ 245 | {given a cookie string or block, all cookies are returned} 246 | cookie-string [string! block!] 247 | ][ 248 | cookies: copy [] 249 | if string? cookie-string [ 250 | tmp: copy [] 251 | append tmp cookie-string 252 | cookie-string: tmp 253 | ] 254 | exes: ["path=" "MAX-AGE=" "uauth=true" "domain=.stackoverflow.com" "expires=" ".ASPXBrowserOverride="] 255 | exclusions?: function [e][ 256 | for-each element exes [ 257 | if find e element [ 258 | return false 259 | ] 260 | ] 261 | true 262 | ] 263 | 264 | for-each cookie cookie-string [ 265 | for-each element split cookie ";" [ 266 | trim/head/tail element 267 | if all [ 268 | find element "=" 269 | exclusions? element 270 | ][ 271 | append cookies element 272 | ] 273 | ] 274 | ] 275 | cookies 276 | ] 277 | 278 | update-cookie-jar: procedure [ 279 | {adds cookies to cookie-jar or updates if present} 280 | headers [object!] site [block!] 281 | ][ 282 | if all [ 283 | find headers 'set-cookie 284 | cookies: find-all-cookies headers/set-cookie 285 | not empty? cookies 286 | ][ 287 | either find cookie-jar site/host [ 288 | repend cookie-jar [lock site/host cookies] 289 | ][ 290 | lock site/host 291 | cookie-jar/(site/host): cookies 292 | ] 293 | ] 294 | ] 295 | 296 | search-cookie-jar: function [ 297 | {returns any cookies that match the domain} 298 | cookie-jar [map!] domain [string!] 299 | ][ 300 | result: collect [ 301 | for-each [key value] cookie-jar [ 302 | if find key domain [ 303 | keep value 304 | ] 305 | ] 306 | ] 307 | delimit result "; " 308 | ] 309 | 310 | lib/login2so: function [ 311 | {login to stackoverflow and return an authentication object} 312 | email [email!] password [string!] chat-page [url!] 313 | ][ 314 | configobj: make object! [fkey: copy "" bot-cookie: copy ""] 315 | fkey: _ 316 | root: https://stackoverflow.com 317 | loginpage: to string! read loginurl: https://stackoverflow.com/users/login 318 | print "read ..." 319 | if parse loginpage [thru "login-form" thru {action="} copy action to {"} thru "fkey" thru {value="} copy fkey to {"} thru {"submit-button"} thru {value="} copy login to {"} to end][ 320 | ; dump action 321 | postdata: to-webform reduce ['fkey fkey 'email email 'password password 'submit-button login] 322 | print "posting login data" 323 | result: trap [ 324 | write post-url: to url! unspaced [root action] compose/deep 325 | [headers no-redirect POST [Content-Type: "application/x-www-form-urlencoded; charset=utf-8"] (postdata)] 326 | ] 327 | ; grab the headers and update the cookie-jar after successful authentication 328 | update-cookie-jar headers: result/spec/debug/headers site: sys/decode-url post-url 329 | 330 | ; now grab the SO cookies - we are asked to redirect there but we don't need to as we only need the cookies 331 | site: sys/decode-url url: to url! headers/location 332 | cookie: search-cookie-jar cookie-jar site/host 333 | 334 | ; now grab the chatroom cookie, "chatusr" but it doesn't seem to be used?? 335 | result: trap [ 336 | write chat-page compose/deep [headers no-redirect GET [cookie: (cookie)]] 337 | ] 338 | 339 | update-cookie-jar headers: result/spec/debug/headers site: sys/decode-url chat-page 340 | if not parse to string! result/data [ thru {name="fkey"} thru {value="} copy fkey to {"} to end ][ 341 | fail "No Fkey so can not login" 342 | ] 343 | configobj/fkey: fkey 344 | ; there's a chat.stackoverflow.com coookie but it wants the stackoverflow.com cookie! 345 | ; configobj/bot-cookie: delimit cookie-jar/("stackoverflow.com") "; " 346 | configobj/bot-cookie: search-cookie-jar cookie-jar "stackoverflow.com" 347 | ] 348 | configobj 349 | ] 350 | lib/get-userid: func [ txt 351 | /local page userid err rule 352 | ][ 353 | userid: err: _ 354 | txt: copy ajoin [ {("} txt {")} ] 355 | rule: [ 356 | thru "update_user(" 357 | thru txt thru "chat.sidebar.loadUser(" 358 | copy userid digits ( 359 | userid: to integer! userid 360 | ; avoid anti-flooding 361 | ; ?? userid 362 | wait 2 363 | ) 364 | to end 365 | ] 366 | if error? err: trap [ 367 | page: to string! read html-url 368 | if not parse page rule [ 369 | ; print "failed the parse" 370 | lib/log join-of "parse failed for " txt 371 | ] 372 | ][ lib/log mold/all err ] 373 | userid 374 | ] 375 | 376 | lib/speak-private: func [message room-id] [ 377 | bind write-chat-block 'room-id 378 | probe rejoin compose copy write-chat-block 379 | to string! write rejoin compose copy write-chat-block compose/deep copy/deep [ 380 | POST 381 | [(header)] 382 | (rejoin ["text=" lib/url-encode message "&fkey=" auth-object/fkey]) 383 | ] 384 | ] 385 | 386 | lib/log: func [text][ 387 | write/append log-file reform [ now/date now/time mold text newline ] 388 | ] 389 | 390 | lib/speak: func [message /local err] [ 391 | if error? err: trap [ 392 | write chat-target-url compose/deep copy/deep [ 393 | headers no-redirect POST 394 | [(header)] 395 | (rejoin ["text=" lib/url-encode message "&fkey=" auth-object/fkey]) 396 | ] 397 | ][ 398 | probe err 399 | ] 400 | ] 401 | 402 | ; mini-http is a minimalistic http implementation 403 | mini-http: func [ url [url!] method [word! string!] cookies [string!] code [string!] timeout [integer!] 404 | /local url-obj http-request payload result port 405 | ][ 406 | http-request: {$method $path HTTP/1.0 407 | Host: $host 408 | User-Agent: Mozilla/5.0 409 | Accept: text/html 410 | Content-Length: $len 411 | Content-Type: text/plain; charset=UTF-8 412 | Set-Cookie: $cookies 413 | $code} 414 | 415 | url-obj: construct/with sys/decode-url url make object! copy [port-id: 80 path: ""] 416 | if empty? url-obj/path [ url-obj/path: copy "/" ] 417 | payload: reword http-request reduce [ 418 | 'method method 419 | 'path url-obj/path 420 | 'host url-obj/host 421 | 'cookies cookies 422 | 'len length? code 423 | 'code code 424 | ] 425 | probe payload 426 | port: make port! rejoin [tcp:// url-obj/host ":" url-obj/port-id] 427 | port/awake: func [event] [ 428 | switch/default event/type [ 429 | lookup [open event/port false ] 430 | connect [write event/port to binary! join-of payload newline false] 431 | wrote [read event/port false] 432 | read done [ 433 | ; probe event/port/data 434 | result: to-string event/port/data true ] 435 | ][ true ] 436 | ] 437 | open port 438 | either port? wait [ port timeout ][ 439 | result 440 | ][ ; timeout 441 | _ 442 | ] 443 | ] 444 | 445 | lib/read-messages: func [cnt] [ 446 | to string! write read-target-url compose/deep copy/deep [ 447 | POST 448 | [(header)] 449 | (rejoin ["since=0&mode=Messages&msgCount=" cnt "&fkey=" auth-object/fkey]) 450 | ] 451 | ] 452 | 453 | lib/read-message: func [message-id] [ 454 | to string! read rejoin [read-message-target-url "/" message-id] 455 | ] 456 | 457 | lib/delete-message: func [parent-id message-id /silent 458 | /local result mess 459 | ] [ 460 | ; POST /messages/8034726/delete HTTP/1.1 461 | result: to string! write probe mess: rejoin compose copy delete-url compose/deep copy/deep [ 462 | POST 463 | [(header)] 464 | (rejoin ["fkey=" auth-object/fkey]) 465 | ] 466 | if not silent [ 467 | switch/default result [ 468 | {"It is too late to delete this message"} [lib/reply message-id ["sorry, it's too late to do this now. Be quicker next time"]] 469 | {"ok"} [lib/reply message-id ["done"]] 470 | ] [ 471 | lib/reply message-id ["SO says: " result] 472 | ] 473 | ] 474 | ] 475 | 476 | lib/reply: func [message-id text [string! block!]] [ 477 | if block? text [text: ajoin text] 478 | lib/speak ajoin [":" message-id " " text] 479 | ] 480 | 481 | process-dialect: func [expression 482 | ] [ 483 | default-rule: [ 484 | ; default .. checks for a word and sends it to the check-keys 485 | opt '? [set search-key word! | set search-key string!] opt ['for set recipient word!] ( 486 | lib/done: true 487 | either word? recipient [ 488 | recipient: ajoin ["@" recipient] 489 | ] [ 490 | recipient: copy "" 491 | ] 492 | process-key-search trim ajoin [search-key " " recipient] 493 | ) 494 | ] 495 | 496 | dialect-rule: collect [ 497 | for-each command lib/commands [ 498 | keep/only command/dialect-rule keep '| 499 | ] 500 | ] 501 | insert tail insert dialect-rule quote ((recipient: _)) default-rule 502 | lib/done: false 503 | 504 | if error? err: trap [ 505 | 506 | ; traps illegal rebol values eg @Graham 507 | if error? err2: trap [ 508 | to block! expression 509 | ] [ 510 | if all [ 511 | in err2 'arg1 512 | in err2 'arg2 513 | "email" = get in err2 'arg1 514 | ][ 515 | replace/all expression "@" "" 516 | ] 517 | ] 518 | unless parse expression: to block! expression dialect-rule [ 519 | print "was not parsed by dialect-rule" 520 | ] 521 | unless lib/done [ 522 | response: lib/reply lib/message-id eliza/match mold expression 523 | if found? find response "code: 513" [ 524 | ; Very likely that the cookie has expired - try to log in again 525 | lib/log "Re-authenticating ..." 526 | auth-object: lib/login2so bot-config/bot-user bot-config/bot-pass bot-config/bot-room 527 | lib/log "Logged in" 528 | ] 529 | ] 530 | ] [ 531 | ; sends error 532 | lib/log mold err 533 | ; now uses Eliza 534 | print "trying eliza instead of dumping not understood command " 535 | lib/reply lib/message-id eliza/match mold expression 536 | ] 537 | ] 538 | 539 | process-key-search: func [expression 540 | /local understood search-key person 541 | ] [ 542 | understood: false 543 | set [search-key person] parse expression _ 544 | unless all [ 545 | person 546 | parse person ["@" to end] 547 | ] [person: _] 548 | ; remove punctuation of ! and ? 549 | if find [#"!" #"?"] last search-key [remove back tail search-key] 550 | foreach [key data] lib/bot-expressions [ 551 | if find/part probe key probe search-key length? search-key [ 552 | understood: true 553 | lib/reply lib/message-id ["[" data/1 "](" data/2 ") " either found? person [person] [""]] 554 | break 555 | ] 556 | ] 557 | if not understood [ 558 | ; lib/reply lib/message-id [ {sorry "} expression {" is not in my current repertoire. Try /h for help} ] 559 | lib/reply lib/message-id eliza/match mold expression 560 | ] 561 | ] 562 | 563 | bot-cmd-rule: [ 564 | [ 565 | lib/botname some space 566 | copy key to end (print "got key") 567 | | 568 | "rebol3> " any space copy key to end ( insert head key "do " ) 569 | | 570 | ">> " (print ">> rule") any space copy key to end ( either not find key newline [ insert head key "do " ][ key: copy ""] ) 571 | | 572 | "rebol2> " any space copy key to end ( insert head key "do/2 " ) 573 | ;| 574 | ;"red> " any space copy key to end ( insert head key "do/red " ) 575 | ] 576 | ; process-key-search trim key 577 | ( 578 | print "completed rules" 579 | replace/all key
newline trim key 580 | dump key 581 | if not empty? key [ 582 | print "processing dialect-rule" 583 | process-dialect key 584 | ] 585 | ) 586 | ] 587 | 588 | message-rule: [ 589 | quote 1 | 590 | set timestamp integer! | 591 | set content string! | 592 | integer! | 593 | set person-id integer! | 594 | set user-name string! | 595 | integer! | 596 | string! | 597 | set message-id integer! | 598 | set parent-id integer! | 599 | logic! | 600 | tag! skip | 601 | end 602 | ( 603 | lib/timestamp: timestamp 604 | lib/person-id: person-id 605 | lib/user-name: user-name 606 | lib/message-id: message-id 607 | lib/parent-id: parent-id 608 | ) 609 | ] 610 | 611 | call-command-pulse: function [] [ 612 | for-each command lib/commands [ 613 | if all [ 614 | callback: find words-of command 'pulse-callback 615 | function? :callback 616 | ] [command/pulse-callback] 617 | ] 618 | ] 619 | 620 | ; Initial login 621 | auth-object: lib/login2so bot-config/bot-user bot-config/bot-pass bot-config/bot-room 622 | print auth-object 623 | 624 | ; perhaps not all of this header is required 625 | header: compose [ 626 | Host: "chat.stackoverflow.com" 627 | Origin: "http://chat.stackoverflow.com" 628 | Accept: "application/json, text/javascript, */*; q=0.01" 629 | X-Requested-With: "XMLHttpRequest" 630 | Referer: (referrer-url) 631 | Accept-Encoding: "gzip,deflate" 632 | Accept-Language: "en-US" 633 | Accept-Charset: "ISO-8859-1,utf-8;q=0.7,*;q=0.3" 634 | Content-Type: "application/x-www-form-urlencoded" 635 | cookie: (auth-object/bot-cookie) 636 | ] 637 | 638 | cnt: copy 0 ; rescan for new users every 10 iterations ( for 5 seconds, that's 50 seconds ) 639 | bot-message-cnt: copy 0 ; stop the bot monopolising the room 640 | 641 | ; test speak 642 | lib/speak "Hi guys, I'm back again" 643 | 644 | ; eval loop 645 | forever [ 646 | cnt: cnt + 1 647 | if error? errmain: trap [ 648 | result: load-json/flat lib/read-messages lib/no-of-messages 649 | messages: result/2 650 | ; now skip thru each message and see if any unread 651 | comment { 652 | msg: => [ 653 | 1 654 | 1494756394 655 | {
@RebolBot
print "hello"
print "goodbye"
} 656 | 76852 657 | "Graham Chiu" 658 | 291 659 | 37088369 660 | 37088353 661 | ] 662 | } 663 | 664 | for-each msg messages [ 665 | content: lib/user-name: _ lib/message-id: 0 666 | if not parse msg [some message-rule] [ 667 | print "failed to parse message" 668 | ] 669 | if error? trap [ 670 | ; temporary until altxml is correctly ported to ren-c 671 | content: trim decode-xml content 672 | ][ 673 | content: copy "" 674 | ] 675 | if all [ 676 | lib/timestamp < lib/two-minutes-ago 677 | not exists? join-of lib/storage lib/message-id 678 | ][ 679 | ; print [ "saving " lib/message-id ] 680 | write join-of lib/storage lib/message-id to-json msg 681 | ] 682 | ; failsafe counter 683 | if equal? remove copy bot-config/botname lib/user-name [ bot-message-cnt: bot-message-cnt + 1 ] 684 | if bot-message-cnt > 5 [ quit/with 42 ] ; if the last 8 messages were by the bot then die 685 | 686 | ; new message? 687 | changed: false 688 | if any [ 689 | ; new directive 690 | lib/message-id > lastmessage-no 691 | ; old directive now edited changed 692 | all [ 693 | ; we found this order before 694 | something? changed: find orders-cache lib/message-id ; none | series 695 | content <> select orders-cache first changed 696 | ] 697 | ][ ; only gets here if a new order, or, if an old order that was updated 698 | remove/part either series? changed [changed] [orders-cache] 2 699 | ; save new or updated order 700 | repend orders-cache [lib/message-id content] 701 | print "New message" 702 | save last-message-file lastmessage-no: lib/message-id 703 | ; {
@RebolBot /x a: "Hello"
print a
} 704 | ; {
@rebolbot
print "ehll"
} 705 | 706 | comment { 707 | msg: => [ 708 | 1 709 | 1494756394 710 | {
@RebolBot
print "hello"
print "goodbye"
} 711 | 76852 712 | "Graham Chiu" 713 | 291 714 | 37088369 715 | 37088353 716 | ] 717 | } 718 | 719 | ; strip out all html stuff to get the content 720 | parse content [ 721 | [
| 
 ]
722 |                     opt some space
723 |                     copy content: to [ "
" | "" ] 724 | ( 725 | if parse content [any space lib/botname [#" "
| "^M" ] to end] [ 726 | ; treat a newline after botname as a do-rule] 727 | replace content
"do " 728 | replace content "^M^/" " do " 729 | ] 730 | replace/all content
newline trim content 731 | ) 732 | ] 733 | either parse content bot-cmd-rule [ 734 | print "message for me, we should have dealt with it in the parse rule?" 735 | ][ 736 | print "working as expected" 737 | ] 738 | ] 739 | ] ; end of for-each loop 740 | ] [ 741 | print "jumped to error handler" 742 | probe mold errmain 743 | ] 744 | if cnt >= 10 [ 745 | cnt: 0 746 | print "calling command pulse" 747 | call-command-pulse 748 | ] 749 | bot-message-cnt: 0 750 | print "sync-commands" 751 | sync-commands 752 | attempt [ wait lib/pause-period ] 753 | ] 754 | 755 | halt 756 | -------------------------------------------------------------------------------- /server/eval.reb: -------------------------------------------------------------------------------- 1 | #!#!/sbin/r3 -cs 2 | REBOL [ 3 | title: "Rebol safe evaluation service" 4 | file: %eval.reb 5 | author: "Graham Chiu" 6 | date: 14-May-2017 7 | version: 0.0.7 8 | notes: { 9 | attempt to provide a partially safe environment for rebol evaluation 10 | though will not survive a determined rebol hacker 11 | } 12 | ] 13 | 14 | print ajoin [ 15 | "Content-type: text/plain" crlf 16 | crlf 17 | 18 | ] 19 | 20 | cgi: construct [] [ ; CGI environment variables 21 | SERVER_SOFTWARE: 22 | SERVER_NAME: 23 | SERVER_ADDR: 24 | SERVER_PORT: 25 | REMOTE_ADDR: 26 | DOCUMENT_ROOT: 27 | REQUEST_SCHEME: 28 | CONTEXT_PREFIX: 29 | CONTEXT_DOCUMENT_ROOT: 30 | SERVER_ADMIN: 31 | SCRIPT_FILENAME: 32 | REMOTE_PORT: 33 | GATEWAY_INTERFACE: 34 | SERVER_PROTOCOL: 35 | REQUEST_METHOD: 36 | QUERY_STRING: 37 | REQUEST_URI: 38 | CONTENT_LENGTH: 39 | SCRIPT_NAME: _ 40 | ; path-info: 41 | ; path-translated: 42 | ; remote-host: 43 | ; auth-type: 44 | ; remote-user: 45 | ; remote-ident: 46 | ; Content-Type: ; cap'd for email header 47 | ; content-length: _ 48 | other-headers: [] 49 | ] 50 | 51 | ;for-each w words-of cgi [ 52 | ; print/eval [form w "=" get-env w] 53 | ;] 54 | 55 | ; set the CGI object from the linux environment 56 | env: collect [ 57 | for-each w words-of cgi [ 58 | keep get-env w 59 | ] 60 | ] 61 | set words-of cgi env 62 | 63 | ; disable read outside current directory 64 | old-read: copy :read 65 | hijack 'read adapt 'old-read [ 66 | if file? :source [ 67 | source: clean-path source 68 | if not find source what-dir [ 69 | fail "Not allowed to read outside the jail!" 70 | ] 71 | ] 72 | ] 73 | 74 | ; disable disk writes 75 | old-write: copy :write 76 | hijack 'write adapt 'old-write [ 77 | if any [ 78 | file? :destination 79 | all [block? :destination 'file = select destination 'scheme] 80 | ][ 81 | fail "Not allowed to write to file when in jail!" 82 | ] 83 | ] 84 | 85 | ; disable disk open 86 | old-open: copy :open 87 | hijack 'open adapt 'old-open [ 88 | if any [ 89 | file? :spec 90 | all [block? :spec 'file = select spec 'scheme] 91 | ][ 92 | fail "Not allowed to open disk files while in jail!" 93 | ] 94 | ] 95 | 96 | for-each w paranoid: [ 97 | old-write 98 | old-read 99 | old-open 100 | call 101 | cd change-dir 102 | ls list-dir 103 | rm 104 | make-routine ; FFI 105 | ][unset w] 106 | 107 | ; check coming from chat 108 | if cgi/REMOTE_ADDR <> read dns://rebol.info [ 109 | ; print | dump remote-client | fail "Execution only allowed from rebolbot's server " 110 | ] 111 | 112 | if cgi/REQUEST_METHOD = "GET" [ 113 | if parse cgi/QUERY_STRING ["eval=" copy doable: to end][ 114 | print 115 | doable: dehex doable 116 | dump doable 117 | if error? error: trap [ 118 | do doable 119 | ][ 120 | probe error 121 | ] 122 | print 123 | ] 124 | ] 125 | 126 | if cgi/REQUEST_METHOD = "POST" [ 127 | cgidata: copy to binary! "" 128 | while [ 129 | all [ 130 | not error? trap [data: read system/ports/input] 131 | 0 < probe length data 132 | ] 133 | ][ 134 | append cgidata data 135 | ] 136 | print 137 | if error? err: trap [ 138 | ; print/eval 139 | result: do cgidata 140 | if set? 'result [ 141 | ; a value returned by the action 142 | either block? :result [ 143 | print mold :result 144 | ][ 145 | print result 146 | ] 147 | ] 148 | ][ 149 | print mold err 150 | ] 151 | print 152 | ] 153 | -------------------------------------------------------------------------------- /server/evalr2.r: -------------------------------------------------------------------------------- 1 | #!/sbin/rebol -cs 2 | REBOL [ 3 | title: "Rebol safe evaluation service" 4 | file: %evalr2.r 5 | author: "Graham Chiu" 6 | date: 18-May-2017 7 | version: 0.0.1 8 | notes: { 9 | attempt to provide a partially safe environment for rebol evaluation 10 | though will not survive a determined rebol hacker 11 | } 12 | ] 13 | 14 | secure [net allow file throw] 15 | 16 | print rejoin [ 17 | "Content-type: text/plain" crlf 18 | crlf 19 | 20 | ] 21 | 22 | cgi: system/options/cgi 23 | 24 | ; check coming from chat 25 | ;if cgi/REMOTE-ADDR <> read dns://rebol.info [ 26 | ; ; print | dump remote-client | fail "Execution only allowed from rebolbot's server " 27 | ;] 28 | 29 | if cgi/REQUEST-METHOD = "GET" [ 30 | if parse cgi/QUERY-STRING ["eval=" copy doable to end][ 31 | print 32 | doable: dehex doable 33 | ?? doable 34 | if error? set/any 'err try [ 35 | do doable 36 | ][ 37 | probe disarm get/any 'err 38 | ] 39 | print 40 | ] 41 | ] 42 | 43 | if cgi/REQUEST-METHOD = "POST" [ 44 | cgidata: make string! 1020 45 | buffer: make string! 16380 46 | while [positive? read-io system/ports/input buffer 16380][ 47 | append cgidata buffer 48 | clear buffer 49 | ] 50 | print 51 | if error? set/any 'err try [ 52 | do cgidata 53 | ][ 54 | print disarm get/any 'err 55 | ] 56 | print 57 | ] 58 | -------------------------------------------------------------------------------- /shrink.reb: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Simple Virtual Shrink" 3 | Date: 10-Jun-1999 4 | File: %shrink.reb 5 | Author: "Martin Johannesson" 6 | Purpose: { 7 | This script is a virtual shrink "chatter bot". 8 | It was obviously inspired by the original shrink bot 9 | called Eliza. When the program gets a sentence in 10 | English, it tries to find a matching rule in its 11 | rule database and if it understands the sentence 12 | it tries to give a reasonable reply. 13 | (Type "quit" to quit) 14 | } 15 | Notes: {14-May-2017 modded to work with ren-c - Graham} 16 | Email: %d95-mjo--nada--kth--se 17 | library: [ 18 | level: 'advanced 19 | platform: _ 20 | type: _ 21 | domain: 'game 22 | tested-under: _ 23 | support: _ 24 | license: _ 25 | see-also: _ 26 | ] 27 | ] 28 | 29 | chat-bot: make object! [ 30 | 31 | rules: copy [] 32 | substitutions: [ 33 | "are" [substitute-verb "I" "am" "you" tokens] 34 | "am" [substitute-verb "you" "are" "I" tokens] 35 | "were" [substitute-verb "I" "was" "you" tokens] 36 | "was" [substitute-verb "you" "were" "I" tokens] 37 | "weren't" [substitute-verb "I" "wasn't" "you" tokens] 38 | "wasn't" [substitute-verb "you" "weren't" "I" tokens] 39 | "my" ["your"] 40 | "mine" ["yours"] 41 | "me" ["you"] 42 | "I" ["you"] 43 | "I'm" ["you're"] 44 | "I'd" ["you'd"] 45 | "I'll" ["you'll"] 46 | "you" [substitute-you tokens] 47 | "you're" ["I'm"] 48 | "you'd" ["I'd"] 49 | "you'll" ["I'll"] 50 | "your" ["my"] 51 | "yours" ["mine"] 52 | ] 53 | 54 | prepositions: [ 55 | "on" "from" "to" "at" "in" "through" "by" "for" 56 | "without" "with" "around" "behind" "before" "of" 57 | "beside" "under" "over" "between" "after" "about" 58 | ] 59 | 60 | substitute-you: func [tokens] [ 61 | either any [ 62 | (find prepositions (pick tokens -1)) 63 | (find prepositions (pick tokens 2)) 64 | ]["me"]["I"] 65 | ] 66 | 67 | substitute-verb: func [prev-word new-word next-word tokens] [ 68 | either any [ 69 | ((pick tokens -1) = prev-word) 70 | ((pick tokens 2) = next-word) 71 | ][new-word][first tokens] 72 | ] 73 | 74 | sentence-chars: charset [#" " #"?" #"!" #"." #","] 75 | 76 | substitute: func [sentence /local subst-word] [ 77 | tokens: split sentence sentence-chars ;" ?!.," 78 | while [not tail? tokens] [ 79 | subst-word: do select substitutions first tokens 80 | if any [subst-word] [ 81 | change tokens subst-word 82 | ] 83 | tokens: next tokens 84 | ] 85 | return head tokens 86 | ] 87 | 88 | make-parse-rule: func [match-rule /local parse-rule token] [ 89 | parse-rule: copy [] 90 | while [not tail? match-rule] [ 91 | token: first match-rule 92 | parse-rule: join-of parse-rule either word? token [[ 93 | 'copy token 94 | 'to either tail? next match-rule ['end][ 95 | second match-rule 96 | ] 97 | ] 98 | ][token] 99 | match-rule: next match-rule 100 | ] 101 | return parse-rule 102 | ] 103 | 104 | 105 | match: func [sentence /local reply token] [ 106 | foreach [p-symbol phrases r-symbol replies] rules [ 107 | foreach phrase phrases [ 108 | if parse sentence make-parse-rule phrase [ 109 | reply: pick replies random (length? replies) 110 | foreach token reply [ 111 | if word? token [ 112 | set :token substitute get token 113 | ] 114 | ] 115 | return rejoin head reply 116 | ] 117 | ] 118 | ] 119 | ] 120 | 121 | input-eval-loop: func [] [ 122 | while [true] [ 123 | sentence: ask "chatbot> " 124 | if sentence = "quit" [break] 125 | print match sentence 126 | ] 127 | ] 128 | ] 129 | 130 | rules: [ 131 | 132 | phrases [ 133 | ["hello" x] 134 | ["hi" x] 135 | ] 136 | replies [ 137 | ["Hey, please state your problem."] 138 | ["Hi, please state your problem."] 139 | ["Hello, please state your problem."] 140 | ] 141 | 142 | phrases [["what's up" x]] 143 | replies [ 144 | ["Nothing"] 145 | ["Not much"] 146 | ] 147 | 148 | phrases [[z "sorry" y]] 149 | replies [ 150 | ["Please don't applogize."] 151 | ["Appologies are not necessary."] 152 | ["What feelings do you have when you apologize?"] 153 | ] 154 | 155 | phrases [[z "I remember " y]] 156 | replies [ 157 | ["Do you often think of " y "?"] 158 | ["Does thinking of " y " bring anything else to mind?"] 159 | ["What else do you remember?"] 160 | ["Why do you remember " y " just now?"] 161 | ["What in the present situation reminds you of " y "?"] 162 | ["What is the connection between me and " y "?"] 163 | ] 164 | 165 | phrases [[z "do you remember " y]] 166 | replies [ 167 | ["Did you think I would forget " y "?"] 168 | ["Why do you think I should recall " y " now?"] 169 | ["What about " y "?"] 170 | ["No, I don't"] 171 | ] 172 | 173 | phrases [["how are you" x]] 174 | replies [ 175 | ["Fine, thanks"] 176 | ["I'm doing ok"] 177 | ["Fine, thanks. How are you?"] 178 | ] 179 | 180 | phrases [[z "I dreamt" y]] 181 | replies [ 182 | ["Really?"] 183 | ["Have you ever fantasised " y " while you were awake?"] 184 | ["Have you ever dreamt " y " before?"] 185 | ["What does that dream suggest to you?"] 186 | ["Do you dream often?"] 187 | ["What persons appear in your dreams?"] 188 | ["Do you believe that dreaming has something to do with your problem?"] 189 | 190 | ] 191 | 192 | phrases [[z "dream" y]] 193 | replies [ 194 | ["What does that dream suggest to you?"] 195 | ["Do you dream often?"] 196 | ["What persons appear in your dreams?"] 197 | ["Do you believe that dreaming has something to do with your problem?"] 198 | ] 199 | 200 | phrases [[z "perhaps" y]] 201 | replies [ 202 | ["You do not seem quite certain."] 203 | ["Why the uncertain tone?"] 204 | ["Can you not be more positive?"] 205 | ["You are not sure?"] 206 | ["Do you not know?"] 207 | ] 208 | 209 | phrases [["what is your name" y]] 210 | replies [ 211 | ["None of your business."] 212 | ["Bond. James Bond"] 213 | ["I'd rather not say."] 214 | ] 215 | 216 | phrases [[z "name" y]] 217 | replies [ 218 | ["I am not interested in names."] 219 | ["Please continue."] 220 | ] 221 | 222 | phrases [ 223 | [z "computer" y] 224 | [z "amiga" y] 225 | [z "macintosh" y] 226 | [z "pc" y] 227 | [z "machine" y] 228 | ] 229 | replies [ 230 | ["Do computers worry you?"] 231 | ["Why do you mention computers?"] 232 | ["What do you think machines have to do with your problem?"] 233 | ["Do you not think computers can help people?"] 234 | ["What about machines worries you?"] 235 | ["What do you think about machines?"] 236 | ] 237 | 238 | phrases [[z "am I " y]] 239 | replies [ 240 | ["Do you believe you are " y "?"] 241 | ["Would you want to be " y "?"] 242 | ["You wish I would tell you you are " y "?"] 243 | ["What would it mean if you were " y "?"] 244 | ] 245 | 246 | phrases [[z "are you " y]] 247 | replies [ 248 | ["What makes you think I'm " y "?"] 249 | ["Why are you interested in whether I am " y " or not?"] 250 | ["Would you prefer if I were not " y "?"] 251 | ["Perhaps I am " y " in your fantasies."] 252 | ["Do you sometimes think I am " y "?"] 253 | ] 254 | 255 | phrases [[z "your " y]] 256 | replies [ 257 | ["Why are you concerned over my " y "?"] 258 | ["What about your own " y "?"] 259 | ["Are you worried about someone elses " y "?"] 260 | ["Really, my " y "?"] 261 | ] 262 | 263 | phrases [[z "was I " y]] 264 | replies [ 265 | ["What if you were " y "?"] 266 | ["Do you think you were " y "?"] 267 | ["Were you " y "?"] 268 | ["What would it mean to you if you were " y "?"] 269 | ["Perhaps I already knew that you were " y "?"] 270 | ] 271 | 272 | phrases [[z "I was " y]] 273 | replies [ 274 | ["Were you really?"] 275 | ["Why do you tell me you were " y " just now?"] 276 | ["Perhaps I already knew you were " y "."] 277 | ] 278 | 279 | phrases [[z "were you " y]] 280 | replies [ 281 | ["Would you like to believe I was " y "?"] 282 | ["What suggests that I was " y "?"] 283 | ["What do you think?"] 284 | ["Perhaps I was " y "."] 285 | ["What if I had been " y "?"] 286 | ] 287 | 288 | phrases [[z "I don't " y]] 289 | replies [ 290 | ["Do you not really " y "?"] 291 | ["Why do you not " y "?"] 292 | ["Do you wish to be ablt to " y "?"] 293 | ["Does that trouble you?"] 294 | ] 295 | 296 | phrases [[z "I feel " y]] 297 | replies [ 298 | ["Tell me more about such feelings."] 299 | ["Do you often feel " y "?"] 300 | ["Do you enjoy feeling " y "?"] 301 | ["Of what does feeling " y " remind you?"] 302 | ] 303 | 304 | phrases [[z "I can't " y]] 305 | replies [ 306 | ["How do you know you can not " y "?"] 307 | ["Have you tried?"] 308 | ["Perhaps you could " y " now?"] 309 | ["Do you really want to be able to " y "?"] 310 | ] 311 | 312 | phrases [ 313 | [z "I want " y] 314 | [z "I need " y] 315 | ] 316 | replies [ 317 | ["What would it mean to you if you got " y "?"] 318 | ["Why do you want " y "?"] 319 | ["Suppose you got " y " soon?"] 320 | ["What if you never got " y "?"] 321 | ["What would getting " y " mean to you?"] 322 | ["What does wanting " y " have to do with this discussion?"] 323 | ] 324 | 325 | phrases [ 326 | [z "I feel " x "I " y] 327 | [z "I think " x "I " y] 328 | [z "I believe " x "I " y] 329 | [z "I wish " x "I " y] 330 | ] 331 | replies [ 332 | ["Do you really think so?"] 333 | ["But are you sure you " y "?"] 334 | ["Do you really doubt you " y "?"] 335 | ] 336 | 337 | phrases [ 338 | [z "I'm " y] 339 | [z "I am " y] 340 | ] 341 | replies [ 342 | ["I am sorry to hear that."] 343 | ["Do you think coming here will help you?"] 344 | ["I am sure it is not pleasant to be " y] 345 | ["Why is that?"] 346 | ["Do you believe it's normal to be " y "?"] 347 | ["How long have you been " y "?"] 348 | ["Do you enjoy being " y "?"] 349 | ["Can you elaborate on that?"] 350 | ] 351 | 352 | phrases [[z "I " x " you" y]] 353 | replies [ 354 | ["Perhaps in your fantasy we " x " each other?"] 355 | ["Do you wish to " x " me?"] 356 | ["You seem to need to " x " me."] 357 | ["Do you " x " anyone else?"] 358 | ] 359 | 360 | phrases [[z "I hate " y]] 361 | replies [ 362 | ["Why do you hate " y "?"] 363 | ] 364 | 365 | phrases [[z "you remind me of " y]] 366 | replies [ 367 | ["What resemblance do you see?"] 368 | ] 369 | 370 | phrases [[z "you are " y]] 371 | replies [ 372 | ["What makes you think I am " y "?"] 373 | ["Does it please you to believe I am " y "?"] 374 | ["Do you sometimes wish you were " y "?"] 375 | ["Perhapes you would like to be " y "?"] 376 | ] 377 | 378 | phrases [[z "you " x "me" y]] 379 | replies [ 380 | ["Why do you think I " x " you?"] 381 | ["You like to think I " x " you, don't you?"] 382 | ["What makes you think I " x " you?"] 383 | ["Really, I " x " you."] 384 | ["Do you wish to believe I " x " you?"] 385 | ["Suppose I did " x " you, what would it mean to you?"] 386 | ["Does someone else believe I " x "you?"] 387 | ] 388 | 389 | phrases [[z "you " y]] 390 | replies [ 391 | ["We were discussing you, not me."] 392 | ["Oh, I " y "."] 393 | ["What are your feelings now?"] 394 | ] 395 | 396 | phrases [["yes" y]] 397 | replies [ 398 | ["You seem quite positive."] 399 | ["Are you sure?"] 400 | ["I see."] 401 | ["I understand"] 402 | ] 403 | 404 | phrases [["no" y]] 405 | replies [ 406 | ["Are you saying that just to be negative?"] 407 | ["You are being a bit negative."] 408 | ["Why not?"] 409 | ["Why no?"] 410 | ] 411 | 412 | phrases [["why don't you " y]] 413 | replies [ 414 | ["Do you believe I do not " y "?"] 415 | ["Perhaps I will " y " in good time."] 416 | ["Should you " y " yourself?"] 417 | ["You want me to " y "?"] 418 | ] 419 | 420 | phrases [["why can't I " y]] 421 | replies [ 422 | ["Do you think you should be able to " y "?"] 423 | ["Do you want to be able to " y "?"] 424 | ["Do you believe this will help you to " y "?"] 425 | ["Have you any idea why you can not " y "?"] 426 | ] 427 | 428 | phrases [ 429 | ["what " y] 430 | ["why " y] 431 | ] 432 | replies [ 433 | ["Why do you ask?"] 434 | ["Does that question interest you?"] 435 | ["What is it you really want to know?"] 436 | ["Are such questions on your mind?"] 437 | ["What answer would please you the most?"] 438 | ["What do you think?"] 439 | ["What comes to your mind when you ask that?"] 440 | ] 441 | 442 | phrases [["because " y]] 443 | replies [ 444 | ["Is that the real reason?"] 445 | ["Do any other reasons not come to mind?"] 446 | ["Does that reason seem to explain anything else?"] 447 | ["What other reasons might there be?"] 448 | ] 449 | 450 | phrases [[z "always" y]] 451 | replies [ 452 | ["Can you think of a specific example?"] 453 | ["When?"] 454 | ["What incident are you thinking of?"] 455 | ["Really, always?"] 456 | ] 457 | 458 | 459 | phrases [[x]] 460 | replies [ 461 | ["What are you trying to say?"] 462 | ["I'm not sure I understand..."] 463 | ["What?"] 464 | ["Please continue."] 465 | ["What do you mean?"] 466 | ["That's very interesting."] 467 | ["Can you elaborate on that?"] 468 | ["Can you be a little more specific?"] 469 | ] 470 | ] 471 | 472 | chat-bot/rules: rules 473 | chat-bot/input-eval-loop 474 | -------------------------------------------------------------------------------- /so-speak.reb: -------------------------------------------------------------------------------- 1 | Rebol [ 2 | title: "Speak on stackoverflow" 3 | author: "Graham" 4 | file: %so-speak.reb 5 | date: 23-July-2017 6 | needs: [ 7 | 8 | ] 9 | settings: [ 10 | email: -bot-email-address@here.com 11 | password: "bot-password" 12 | chat-page: https://chat.stackoverflow.com/rooms/291/rebol 13 | ] 14 | notes: {takes advantage of a new http write dialect word of 'no-redirect 15 | Still needs a generic cookie handling solution 16 | } 17 | ] 18 | 19 | net-trace off 20 | room-id: 291 21 | room-descriptor: "rebol*" 22 | 23 | so-chat-url: https://chat.stackoverflow.com/ 24 | chat-target-url: rejoin write-chat-block: [so-chat-url 'chats "/" room-id "/" 'messages/new] 25 | referrer-url: rejoin [so-chat-url 'rooms "/" room-id "/" room-descriptor] 26 | 27 | cookie-jar: make map! [] 28 | 29 | find-all-cookies: function [ 30 | {given a cookie string or block, all cookies are returned} 31 | cookie-string [string! block!] 32 | ][ 33 | cookies: copy [] 34 | if string? cookie-string [ 35 | tmp: copy [] 36 | append tmp cookie-string 37 | cookie-string: tmp 38 | ] 39 | exes: ["path=" "MAX-AGE=" "uauth=true" "domain=.stackoverflow.com" "expires=" ".ASPXBrowserOverride="] 40 | exclusions?: function [e][ 41 | for-each element exes [ 42 | if find e element [ 43 | return false 44 | ] 45 | ] 46 | true 47 | ] 48 | 49 | for-each cookie cookie-string [ 50 | for-each element split cookie ";" [ 51 | trim/head/tail element 52 | if all [ 53 | find element "=" 54 | exclusions? element 55 | ][ 56 | append cookies element 57 | ] 58 | ] 59 | ] 60 | cookies 61 | ] 62 | 63 | update-cookie-jar: procedure [ 64 | {adds cookies to cookie-jar or updates if present} 65 | headers [object!] site [block!] 66 | ][ 67 | if all [ 68 | find headers 'set-cookie 69 | cookies: find-all-cookies headers/set-cookie 70 | not empty? cookies 71 | ][ 72 | either find cookie-jar site/host [ 73 | repend cookie-jar [lock site/host cookies] 74 | ][ 75 | lock site/host 76 | cookie-jar/(site/host): cookies 77 | ] 78 | ] 79 | ] 80 | 81 | search-cookie-jar: function [ 82 | {returns any cookies that match the domain} 83 | cookie-jar [map!] domain [string!] 84 | ][ 85 | result: collect [ 86 | for-each [key value] cookie-jar [ 87 | if find key domain [ 88 | keep value 89 | ] 90 | ] 91 | ] 92 | delimit result "; " 93 | ] 94 | 95 | login2so: function [ 96 | {login to stackoverflow and return an authentication object} 97 | email [email!] password [string!] chat-page [url!] 98 | ][ 99 | configobj: make object! [fkey: copy "" bot-cookie: copy ""] 100 | fkey: _ 101 | root: https://stackoverflow.com 102 | loginpage: to string! read loginurl: https://stackoverflow.com/users/login 103 | print "read ..." 104 | if parse loginpage [thru "login-form" thru {action="} copy action to {"} thru "fkey" thru {value="} copy fkey to {"} thru {"submit-button"} thru {value="} copy login to {"} to end][ 105 | ; dump action 106 | postdata: to-webform reduce ['fkey fkey 'email email 'password password 'submit-button login] 107 | print "posting login data" 108 | result: trap [ 109 | write post-url: to url! unspaced [root action] compose/deep 110 | [headers no-redirect POST [Content-Type: "application/x-www-form-urlencoded; charset=utf-8"] (postdata)] 111 | ] 112 | ; grab the headers and update the cookie-jar after successful authentication 113 | update-cookie-jar headers: result/spec/debug/headers site: sys/decode-url post-url 114 | 115 | ; now grab the SO cookies - we are asked to redirect there but we don't need to as we only need the cookies 116 | site: sys/decode-url url: to url! headers/location 117 | cookie: search-cookie-jar cookie-jar site/host 118 | 119 | ; now grab the chatroom cookie, "chatusr" but it doesn't seem to be used?? 120 | result: trap [ 121 | write chat-page compose/deep [headers no-redirect GET [cookie: (cookie)]] 122 | ] 123 | 124 | update-cookie-jar headers: result/spec/debug/headers site: sys/decode-url chat-page 125 | if not parse to string! result/data [ thru {name="fkey"} thru {value="} copy fkey to {"} to end ][ 126 | fail "No Fkey so can not login" 127 | ] 128 | configobj/fkey: fkey 129 | ; there's a chat.stackoverflow.com coookie but it wants the stackoverflow.com cookie! 130 | ; configobj/bot-cookie: delimit cookie-jar/("stackoverflow.com") "; " 131 | configobj/bot-cookie: search-cookie-jar cookie-jar "stackoverflow.com" 132 | ] 133 | configobj 134 | ] 135 | 136 | auth-object: login2so system/script/header/settings/email system/script/header/settings/password system/script/header/settings/chat-page 137 | 138 | dump auth-object 139 | 140 | header: compose [ 141 | Host: "chat.stackoverflow.com" 142 | Origin: "http://chat.stackoverflow.com" 143 | Accept: "application/json, text/javascript, */*; q=0.01" 144 | X-Requested-With: "XMLHttpRequest" 145 | Referer: (referrer-url) 146 | Accept-Encoding: "gzip,deflate" 147 | Accept-Language: "en-US" 148 | Accept-Charset: "ISO-8859-1,utf-8;q=0.7,*;q=0.3" 149 | Content-Type: "application/x-www-form-urlencoded" 150 | cookie: (auth-object/bot-cookie) 151 | ] 152 | 153 | speak: func [message /local err] [ 154 | if error? err: trap [ 155 | write chat-target-url compose/deep copy/deep [ 156 | headers no-redirect POST 157 | [(header)] 158 | (rejoin ["text=" url-encode message "&fkey=" auth-object/fkey]) 159 | ] 160 | ][ 161 | probe err 162 | ] 163 | ] 164 | 165 | halt 166 | speak "Final test of new so-chat utility" 167 | -------------------------------------------------------------------------------- /twitter-config-sample.r3: -------------------------------------------------------------------------------- 1 | twitter: http://api.twitter.com/ 2 | Consumer-Key: "-- get your own --" 3 | Consumer-Secret: "-- get your own --" 4 | Users: [ 5 | "id-name" [ 6 | id: #-- id number -- 7 | name: "-- id name --" 8 | token: "-- token --" 9 | secret: "-- secret --" 10 | ] 11 | ] 12 | -------------------------------------------------------------------------------- /twitter.r3: -------------------------------------------------------------------------------- 1 | Rebol [ 2 | Title: "Twitter Client for Rebol" 3 | Author: ["Christopher Ross-Gill" "John Kenyon"] 4 | Date: 10-Jun-2013 5 | Home: http://ross-gill.com/page/Twitter_API_and_Rebol 6 | File: %twitter.reb 7 | Version: 0.3.8 8 | Purpose: { 9 | Rebol script to access and use the Twitter OAuth API. 10 | Warning: Currently configured to use HTTP only 11 | New user registration must be done using rebol 2 version 12 | This function will be updated when https is available (for Linux) 13 | } 14 | Rights: http://opensource.org/licenses/Apache-2.0 15 | Type: module 16 | Name: rgchris.twitter 17 | Exports: [twitter] 18 | Needs: [ ] 19 | History: [] 20 | ] 21 | 22 | twitter: make object! bind [ 23 | as: func [ 24 | "Set current user" 25 | user [string!] "Twitter user name" 26 | ][ 27 | either user: select users user [ 28 | persona: make persona user 29 | persona/name 30 | ][ 31 | either not error? user: try [register][ 32 | repend users [ 33 | user/name 34 | new-line/skip/all body-of user true 2 35 | ] 36 | persona/name 37 | ][do :user] 38 | ] 39 | ] 40 | 41 | save-users: func [ 42 | "Saves authorized users" 43 | /to location [file! url!] "Alternate Storage Location" 44 | ][ 45 | location: any [location settings/user-store] 46 | unless any [file? location url? location][ 47 | make error! "No Storage Location Provided" 48 | ] 49 | save/header location new-line/skip/all users true 2 context [ 50 | Title: "Twitter Authorized Users" 51 | Date: now/date 52 | ] 53 | ] 54 | 55 | authorized-users: func ["Lists authorized users"][extract users 2] 56 | 57 | find: func [ 58 | "Tweets by Search" 59 | query [string! issue! email!] "Search String" 60 | /size count [integer!] /page offset [integer!] 61 | ][ 62 | case [ 63 | issue? query [query: mold query] 64 | email? query [query: join-of "@" query/host] 65 | ] 66 | set words-of params reduce [query offset count] 67 | either attempt [ 68 | result: to string! read join-of http://search.twitter.com/search.json? to-webform params 69 | ] load-result error/connection 70 | ] 71 | 72 | timeline: func [ 73 | "Retrieve a User Timeline" 74 | /for user [string!] /size count [integer!] /page offset [integer!] 75 | ][ 76 | unless persona/name error/credentials 77 | 78 | set words-of options reduce [ 79 | any [:user persona/name _] 80 | any [if integer? :count [min 200 abs count] _] 81 | any [:offset _] 82 | ] 83 | 84 | either do [ 85 | result: send/with 'get %1.1/statuses/user_timeline.json options 86 | ] load-result error/connection 87 | ] 88 | 89 | home: friends: func [ 90 | "Retrieve status messages from friends" 91 | /size count [integer!] /page offset [integer!] 92 | ][ 93 | unless persona/name error/credentials 94 | 95 | set words-of options reduce [ 96 | _ 97 | all [count min 200 abs count] 98 | offset 99 | ] 100 | 101 | either attempt [ 102 | result: send/with 'get %1.1/statuses/home_timeline.json options 103 | ] load-result error/connection 104 | ] 105 | 106 | update: func [ 107 | "Send Twitter status update" 108 | status [string!] "Status message" 109 | /reply "As reply to" id [issue!] "Reply reference" /override 110 | ][ 111 | override: either override [200][140] 112 | unless persona/name error/credentials 113 | unless all [0 < length? status override > length? status] error/invalid 114 | set words-of message reduce [ 115 | status 116 | any [:id _] 117 | ] 118 | either attempt [ 119 | result: send/with 'post %1.1/statuses/update.json message 120 | ] load-result error/connection 121 | ] 122 | 123 | ] make object! [ ; internals 124 | config: case [ 125 | block? system/script/args [ 126 | make object! system/script/args 127 | ] 128 | 129 | file? system/script/args [ 130 | make object! load system/script/args 131 | ] 132 | 133 | exists? %twitter.config.reb [ 134 | make object! load %twitter.config.reb 135 | ] 136 | 137 | /else [ 138 | do make error! "No Configuration Provided" 139 | ] 140 | ] 141 | 142 | root: config/twitter 143 | 144 | settings: make make object! [ 145 | twitter: consumer-key: consumer-secret: users: _ 146 | ][ 147 | consumer-key: config/consumer-key 148 | consumer-secret: config/consumer-secret 149 | ] 150 | 151 | users: config/users 152 | 153 | options: make object! [screen_name: count: page: _] 154 | params: make object! [q: page: rpp: _] 155 | message: make object! [status: in_reply_to_status_id: _] 156 | 157 | result: _ 158 | load-result: [load-json result] 159 | 160 | error: [ 161 | credentials [do make error! "User must be authorized to use this application"] 162 | connection [do make error! "Unable to connect to Twitter"] 163 | invalid [do make error! "Status length should be between between 1 and 140"] 164 | ] 165 | 166 | persona: context [ 167 | id: name: _ 168 | token: secret: _ 169 | ] 170 | 171 | oauth!: context [ 172 | oauth_callback: _ 173 | oauth_consumer_key: settings/consumer-key 174 | oauth_token: oauth_nonce: _ 175 | oauth_signature_method: "HMAC-SHA1" 176 | oauth_timestamp: _ 177 | oauth_version: 1.0 178 | oauth_verifier: oauth_signature: _ 179 | ] 180 | 181 | send: use [make-nonce timestamp sign][ 182 | make-nonce: does [ 183 | enbase/base checksum/secure to binary! join-of form now/precise settings/consumer-key 64 184 | ] 185 | 186 | timestamp: func [/for date [date!]][ 187 | date: any [:date now] 188 | date: form any [ 189 | attempt [to integer! difference date 1-Jan-1970/0:0:0] 190 | date - 1-Jan-1970/0:0:0 * 86400.0 191 | ] 192 | clear find/last date "." 193 | date 194 | ] 195 | 196 | sign: func [ 197 | method [word!] 198 | lookup [url!] 199 | oauth [object! block! blank!] 200 | params [object! block! blank!] 201 | /local out 202 | ][ 203 | out: copy "" 204 | 205 | oauth: any [oauth make oauth! []] 206 | oauth/oauth_nonce: make-nonce 207 | oauth/oauth_timestamp: timestamp 208 | oauth/oauth_token: persona/token 209 | 210 | params: sort/skip unique/skip collect [ 211 | for-each [key value] body-of make oauth any [:params []][ 212 | keep to word! key 213 | keep switch/default type-of value [ 214 | issue! [to string! to word! value] 215 | ][ 216 | value 217 | ] 218 | ] 219 | ] 2 2 220 | 221 | oauth/oauth_signature: enbase/base checksum/secure/key to binary! rejoin [ 222 | uppercase form method "&" replace/all url-encode form lookup "%5f" "_" "&" 223 | replace/all replace/all url-encode replace/all to-webform params "+" "%20" "%5f" "_" "%255F" "_" 224 | ] rejoin [ 225 | settings/consumer-secret "&" any [persona/secret ""] 226 | ] 64 227 | 228 | foreach [header value] body-of oauth [ 229 | if value [ 230 | repend out [", " form to string! to word! header {="} url-encode form value {"}] 231 | ] 232 | ] 233 | 234 | join-of "OAuth" next out 235 | ] 236 | 237 | send: func [ 238 | method [word!] lookup [file!] 239 | /auth oauth [object!] 240 | /with params [object!] 241 | ][ 242 | lookup: join-of dirize root lookup 243 | oauth: make oauth! any [:oauth []] 244 | if object? :params [params: body-of params ] 245 | 246 | switch method [ 247 | put delete [ 248 | params: compose [method: (uppercase form method) (any [params []])] 249 | method: 'post 250 | ] 251 | ] 252 | 253 | switch method [ 254 | get [ 255 | method: compose/deep [ 256 | get [ Authorization: (sign 'get lookup oauth params) ] 257 | ] 258 | if params [ 259 | params: context sort/skip params 2 260 | append lookup to-webform/prefix params 261 | ] 262 | ] 263 | post put delete [ 264 | method: compose/deep [ 265 | (method) [ 266 | Authorization: (sign method lookup oauth params) 267 | Content-Type: "application/x-www-form-urlencoded" 268 | ] 269 | (either params [to-webform params][""]) 270 | ] 271 | ] 272 | ] 273 | lookup: to string! write lookup method 274 | ] 275 | ] 276 | 277 | register: use [request-broker access-broker verification-page][ 278 | request-broker: %oauth/request_token 279 | verification-page: %oauth/authorize?oauth_token= 280 | access-broker: %oauth/access_token 281 | 282 | func [ 283 | /requester request [function!] 284 | /local response verifier 285 | ][ 286 | request: any [:request :ask] 287 | set words-of persona _ 288 | 289 | response: load-webform send/auth 'post request-broker make oauth! [ 290 | oauth_callback: "oob" 291 | ] 292 | 293 | persona/token: response/oauth_token 294 | persona/secret: response/oauth_token_secret 295 | 296 | browse join-of twitter-url/:verification-page response/oauth_token 297 | unless verifier: request "Enter your PIN from Twitter: " [ 298 | make error! "Not a valid PIN" 299 | ] 300 | 301 | response: load-webform send/auth 'post access-broker make oauth! [ 302 | oauth_verifier: trim/all verifier 303 | ] 304 | 305 | persona/id: to-issue response/user_id 306 | persona/name: response/screen_name 307 | persona/token: response/oauth_token 308 | persona/secret: response/oauth_token_secret 309 | 310 | persona 311 | ] 312 | ] 313 | ] 314 | --------------------------------------------------------------------------------