├── Cheyenne ├── BSD-License.txt ├── HTTPd.r ├── cgi-conf.r ├── changelog.txt ├── cheyenne.r ├── docs │ ├── default.css │ ├── developer-guide.html │ └── rsp-api.html ├── embed-demo.r ├── encap-paths.r ├── handlers │ ├── CGI.r │ ├── RSP.r │ └── demo.r ├── httpd.cfg ├── internal │ ├── about.rsp │ ├── backgroundbottom.gif │ ├── backgroundmiddle.gif │ ├── backgroundtop.gif │ ├── bullet.gif │ ├── cheyenne.png │ ├── default.css │ ├── rebol.gif │ └── si.png ├── misc │ ├── admin.r │ ├── call.r │ ├── conf-parser.r │ ├── debug-head.html │ ├── debug-menu.rsp │ ├── macosx.r │ ├── mime.types │ ├── os.r │ ├── service.dll │ ├── system.r │ ├── unix.r │ └── win32.r ├── mods │ ├── mod-action.r │ ├── mod-alias.r │ ├── mod-cors.r │ ├── mod-embed.r │ ├── mod-expire.r │ ├── mod-extapp.r │ ├── mod-fastcgi.r │ ├── mod-internal.r │ ├── mod-rsp.r │ ├── mod-socket.r │ ├── mod-ssi.r │ ├── mod-static.r │ ├── mod-upload.r │ └── mod-userdir.r ├── service │ ├── service.c │ ├── service.h │ ├── service.sln │ └── service.vcproj ├── tests │ ├── catalogs │ │ ├── en │ │ │ └── en.cat │ │ └── fr │ │ │ └── fr.cat │ ├── changelog.txt │ ├── cheyenne-http-tests.r │ ├── cheyenne-supported-http-return-codes.txt │ ├── libs │ │ ├── classes.r │ │ ├── mezz.r │ │ ├── tests.r │ │ ├── unit.r │ │ └── vprint.r │ ├── requirements.txt │ ├── test-groups │ │ ├── GET.r │ │ ├── HEAD.r │ │ └── HEADERS_Accept-Langage.r │ └── www │ │ ├── 200bytes.html │ │ ├── 200bytes.txt │ │ ├── lang.rsp │ │ └── subdir │ │ ├── 200bytes.html │ │ ├── 200bytes.txt │ │ └── lang.rsp └── www │ ├── chat.html │ ├── custom404.html │ ├── email.rsp │ ├── flush.rsp │ ├── form-email.rsp │ ├── inc.rsp │ ├── index.html │ ├── logo.png │ ├── manual.rsp │ ├── perl │ ├── env.cgi │ └── post.cgi │ ├── post.html │ ├── show.cgi │ ├── show.r │ ├── show.rsp │ ├── test.php │ ├── testapp │ ├── app-init.r │ ├── count.rsp │ ├── four.html │ ├── inc.rsp │ ├── index.html │ ├── index.rsp │ ├── login.rsp │ ├── logo.gif │ ├── logo.png │ ├── logout.rsp │ ├── public │ │ └── logo.png │ ├── show.rsp │ └── sixteen.html │ ├── upload.html │ ├── upload.rsp │ ├── ws-apps │ ├── chat.r │ └── ws-test-app.r │ ├── ws.html │ ├── ws.rsp │ └── ws2.html ├── README.md └── UniServe ├── BSD-License.txt ├── change-log.txt ├── clients └── rconsole.r ├── libs ├── cookies.r ├── decode-cgi.r ├── email.r ├── encap-fs.r ├── headers.r ├── html.r ├── idate.r ├── log.r ├── scheduler.r └── url.r ├── protocols ├── DNS.r ├── FastCGI.r ├── SMTP.r └── dig.r ├── services ├── MTA.r ├── RConsole.r ├── logger.r ├── task-master.r └── task-master │ └── task-handler.r └── uni-engine.r /Cheyenne/BSD-License.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009, Nenad Rakocevic / Softinnov 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 5 | 6 | o Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 7 | 8 | o Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 9 | 10 | o Neither the name of Softinnov nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 13 | 14 | -------------------------------------------------------------------------------- /Cheyenne/cgi-conf.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Configure CGI demos for the OS" 3 | Author: onetom@hackerspace.sg 4 | Date: 2011-04-18 5 | Description: { 6 | There are some CGI examples configured with Windows paths for the 7 | Perl and Rebol interpreters: 8 | 9 | #!C:\Perl\bin\perl.exe -wT 10 | #!c:\dev\sdk\tools\rebol.exe --cgi 11 | 12 | Under UNIX systems these should be replaced with that version which can be 13 | found in the $PATH. The scripts should be given an executable flag too. 14 | } 15 | ] 16 | 17 | foreach [file interpreter options] [ 18 | %www/perl/env.cgi perl "-wT" 19 | %www/perl/post.cgi perl "-wT" 20 | %www/show.cgi rebol "--cgi" 21 | ] [ 22 | call/output reform ['which interpreter] path: copy "" 23 | either empty? trim/lines path [ 24 | print [interpreter "not found"] 25 | ][ 26 | probe hash-bang: rejoin ["#!" path " " options] 27 | write/lines file head change/part (read/lines file) hash-bang 1 28 | call reform ["chmod +x" file] 29 | ] 30 | ] 31 | -------------------------------------------------------------------------------- /Cheyenne/docs/default.css: -------------------------------------------------------------------------------- 1 | pre { 2 | font-family:FixedSys,Courier,sans-serif; 3 | font-size:7pt; 4 | } 5 | pre.code { 6 | background-color:#FFFFE0; 7 | color:#808080; 8 | } 9 | 10 | th { 11 | background-color:#EEEEEE; 12 | font-family:Verdana,Arial,sans-serif; 13 | font-size:13.4px; 14 | font-weight:bold; 15 | } 16 | 17 | .col1 { 18 | background-color:#E4EEFF; 19 | font-family:Verdana,Arial,sans-serif; 20 | font-size:13.4px; 21 | font-weight:bold; 22 | text-align:left; 23 | } 24 | 25 | .coln { 26 | background-color:#FFFFE0; 27 | font-family:Verdana,Arial,sans-serif; 28 | font-size:13.4px; 29 | } 30 | 31 | .colnc { 32 | background-color:#FFFFE0; 33 | font-family:Verdana,Arial,sans-serif; 34 | font-size:13.4px; 35 | text-align:center; 36 | } 37 | 38 | -------------------------------------------------------------------------------- /Cheyenne/docs/rsp-api.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/docs/rsp-api.html -------------------------------------------------------------------------------- /Cheyenne/encap-paths.r: -------------------------------------------------------------------------------- 1 | ;=== Copy this file and set your own encap paths 2 | 3 | ;--- Windows include paths --- 4 | #if [system/version/4 = 3] [ 5 | #include %//dev/SDK/v278/Source/mezz.r 6 | #include %//dev/SDK/v278/Source/prot.r 7 | #include %//dev/SDK/v278/Source/gfx-colors.r 8 | ] 9 | ;--- OS X include paths --- 10 | #if [system/version/4 = 2] [ 11 | #include %/Users/dk/Desktop/sdk-278/source/mezz.r 12 | #include %/Users/dk/Desktop/sdk-278/source/prot.r 13 | #include %/Users/dk/Desktop/sdk-278/source/gfx-colors.r 14 | ] 15 | ;--- Linux include paths --- 16 | #if [system/version/4 = 4] [ 17 | #include %/root/Bureau/sdk-v278/source/mezz.r 18 | #include %/root/Bureau/sdk-v278/source/prot.r 19 | #include %/root/Bureau/sdk-v278/source/gfx-colors.r 20 | ] 21 | -------------------------------------------------------------------------------- /Cheyenne/handlers/demo.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "DEMO handler" 3 | ] 4 | 5 | install-module [ 6 | name: 'demo 7 | 8 | on-task-received: func [data][ 9 | data: reduce load data 10 | 11 | result: reform [ ; you have to return the response string in 'result 12 | 13 | "Your IP is :" data/ip 14 | 15 | ] 16 | ] 17 | ] -------------------------------------------------------------------------------- /Cheyenne/httpd.cfg: -------------------------------------------------------------------------------- 1 | modules [ 2 | userdir 3 | internal 4 | extapp 5 | static 6 | upload 7 | ; expire 8 | ; cors 9 | action 10 | fastcgi 11 | rsp 12 | ssi 13 | alias 14 | socket 15 | ; embed 16 | ] 17 | 18 | globals [ 19 | ;--- define alternative and/or multiple listen ports (by default, cheyenne will run on 80) 20 | ;listen [80 10443] 21 | 22 | bind SSI to [.shtml .shtm] 23 | bind php-fcgi to [.php .php3 .php4] 24 | 25 | bind-extern CGI to [.cgi] 26 | bind-extern RSP to [.j .rsp .r] 27 | 28 | ; user "nobody" 29 | ; group "daemon" 30 | 31 | ; persist [sessions mail-queue] 32 | 33 | ; databases [ 34 | ; bugs mysql://root@localhost/bugs 35 | ; ] 36 | 37 | ; worker-libs [ 38 | ; %libs/mysql-protocol.r 39 | ; on-quit [ 40 | ; %/libs/close-all.r 41 | ; ] 42 | ; ] 43 | 44 | ; jobs [ 45 | ; every 5 s do [prin "."] 46 | ; ] 47 | 48 | ; block [ 49 | ; "w00tw00t" ;-- block DFind scanner 50 | ; "msgimport" ;-- block msg import interface attacks 51 | ; " http://" ;-- block proxy relay attempts 52 | ; " GET " ;-- block white space base buffer overflow attacks 53 | ; "php" ;-- block attacks targeting PHP scripts 54 | ; ip-host ;-- block web scanners using IP instead of a valid domain in Host header 55 | ; ] 56 | 57 | ; allow-ip-banning 0:01:00 ;-- optionally ban all blocked IP for the time passed as argument 58 | ;-- (1 minute by default if no argument) 59 | 60 | ;=========================================================== 61 | ;=== uncomment the following lines to enable PHP support === 62 | ;=========================================================== 63 | ;if-loaded? mod-extapp [ 64 | ; extern-app [ 65 | ; name php-fcgi 66 | ; url fastcgi://localhost:9999 67 | ; 68 | ; command "..\php\php-cgi.exe -b 127.0.0.1:9999" 69 | ; 70 | ; environment [ 71 | ; PHP_FCGI_MAX_REQUESTS 0 ; Windows=>0, other=>500 72 | ; PHP_FCGI_CHILDREN 10 73 | ; ] 74 | ; 75 | ; channels 1 ; Windows=>1, other=>n 76 | ; 77 | ; ; -- uncomment the following line for UNIX/OSX 78 | ; delay 2 79 | ; ] 80 | ;] 81 | ] 82 | 83 | default [ 84 | root-dir %www/ 85 | 86 | default [%index.html %index.rsp %index.php] 87 | 88 | on-status-code [ 89 | 404 "/custom404.html" 90 | ] 91 | 92 | socket-app "/ws.rsp" ws-test-app 93 | socket-app "/chat.rsp" chat 94 | 95 | webapp [ 96 | virtual-root "/testapp" 97 | root-dir %www/testapp/ 98 | auth "/testapp/login.rsp" 99 | ;debug 100 | ] 101 | 102 | ; allow-cors [cookies headers [Last-Modified] methods [PUT]] from * 103 | 104 | ; "/" [ 105 | ; redirect http://softinnov.org 106 | ; ] 107 | ] 108 | 109 | 110 | ;-------- 111 | ; uncomment the following to run unit testing scripts. 112 | ;-------- 113 | ;localhost [ 114 | ; locales-dir %../catalogs/ 115 | ; root-dir %tests/www/ 116 | ; default [%200bytes.html] 117 | ; 118 | ;] 119 | 120 | 121 | 122 | 123 | ;rebol.si.org [ 124 | ; root-dir %//dev/si-org/old/ 125 | ; default %main.html 126 | ; 127 | ; redirect 301 "/mysql*" "http://si.org/rebol/mysql.shtml" 128 | ; redirect 301 "/rebox*" "http://si.org/rebol/rebox.shtml" 129 | ; redirect 301 "/" "http://si.org" 130 | ; 131 | ; alias "/wiki" %pmwiki/pmwiki.php 132 | ;] 133 | 134 | ; ### 135 | ; To add a new virtual host just duplicate and fill the following 136 | ; example host : 137 | ; 138 | ; my.vhost.com [ 139 | ; root-dir %/www/ ; documents root directory 140 | ; default [...] ; default files 141 | ; ] 142 | ; ### 143 | -------------------------------------------------------------------------------- /Cheyenne/internal/about.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | OS-type: switch system/version/4 [ 3 | 1 ["AmigaOS"] 4 | 2 [pick ["OSX" "MacOS"] system/version/5 = 4] 5 | 3 ["MS Windows"] 6 | 4 ["Linux"] 7 | 5 ["BeOS"] 8 | 6 ["BSDi"] 9 | 7 ["FreeBSD"] 10 | 8 ["NetBSD"] 11 | 9 ["OpenBSD"] 12 | 10 ["Sun Solaris"] 13 | 11 ["IRIX"] 14 | 12 ["HP-UX"] 15 | 15 ["Windows CE"] 16 | 17 ["AIX"] 17 | 19 ["SCO Unix"] 18 | 22 ["QNX RTOS"] 19 | 24 ["SCO Open Server"] 20 | 27 ["Tao Elate/Intent"] 21 | 28 ["QNX RTP"] 22 | ] 23 | %> 24 | 25 | 26 | 27 | Cheyenne :: About 28 | 29 | 30 | SOFTINNOV 31 | 32 | 33 | 34 |
35 | 46 |
47 |
48 |

Server Status: Online

49 | 50 |

51 | 52 | 53 | 54 | 55 |
Operating System<%=OS-type%>
Cheyenne Version0.9.9.0
REBOL Version<%=system/version%>
56 | 57 |
58 |
59 | 67 | 68 |
69 | 70 | 71 | -------------------------------------------------------------------------------- /Cheyenne/internal/backgroundbottom.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/backgroundbottom.gif -------------------------------------------------------------------------------- /Cheyenne/internal/backgroundmiddle.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/backgroundmiddle.gif -------------------------------------------------------------------------------- /Cheyenne/internal/backgroundtop.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/backgroundtop.gif -------------------------------------------------------------------------------- /Cheyenne/internal/bullet.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/bullet.gif -------------------------------------------------------------------------------- /Cheyenne/internal/cheyenne.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/cheyenne.png -------------------------------------------------------------------------------- /Cheyenne/internal/default.css: -------------------------------------------------------------------------------- 1 | body { background: #eee; font-size:12px; font-family: arial,sans-serif; color:#666666; } 2 | h1 { font-size:18px; font-weight: bold; color: #666666; letter-spacing: +0.1em; } 3 | h2 { font-size:16px; } 4 | a { color: #000066; xtext-decoration:none; } 5 | a:hover { text-decoration: underline; } 6 | a.inactiveMenu, a.activeMenu { padding:0 20px; font-size:14px; } 7 | a.inactiveMenu { color: #666666; } 8 | a.activeMenu { color: #ffffff; background:#666666; } 9 | a.inactiveMenu:hover { text-decoration:underline; } 10 | input, textarea { font-family: verdana, sans-serif; font-size: 8pt; } 11 | div.li { margin: 0 0 0 10px; padding: 0 0 0 12px; list-style-position: inside; background: url(@bullet.gif) no-repeat; } 12 | li { list-style-position: outside; list-style-type: none; padding-left: 10px; background: url(@bullet.gif) no-repeat; } 13 | p { margin-bottom:5px; } 14 | #logo { padding: 15px 0;} 15 | #menu { border-top:1px solid #666666; text-align:center; font-weight: bold; } 16 | #menu a { text-decoration:none; } 17 | #page { width: 600px; height: 400px; padding: 0; margin: 0 auto; } 18 | #header, #content, #footer { padding: 20px 20px; } 19 | #header { background: transparent url(@backgroundtop.gif) no-repeat top center; } 20 | #content { height: 400px; background: transparent url(@backgroundmiddle.gif) repeat center; } 21 | #footer { text-align:right; background: transparent url(@backgroundbottom.gif) no-repeat bottom center; } 22 | #footmessage { border-top:1px solid #666666; } 23 | .visibleBox { display:block; } 24 | .invisibleBox { display:none; } 25 | .borderGrey, .formWidget { border-width: 1px; border-style: solid; border-color: #666; } 26 | .formWidget { width:278px; margin-bottom:5px; } 27 | .news { padding-bottom: 5px; margin-left: 5px; } 28 | .citation {margin:auto;width:450px;font-size:18px;font-style:italic;text-align:center;} 29 | .cartouche {width:280px;text-align:center;float:left;margin:25px;} 30 | .soft-table { 31 | background-color: black; 32 | border-width:1px; 33 | border-collapse:collapse; 34 | border-style:solid; 35 | border-color:#AAA; 36 | padding:10px; 37 | margin: 20px 20px; 38 | font-family:verdana, arial, Helvetica, sans-serif; 39 | font-size:.8em; 40 | } 41 | 42 | .soft-table th { 43 | background-color:#EEEEEE; 44 | font-weight:bold; 45 | } 46 | 47 | .soft-table td { 48 | border-width:1px; 49 | border-style:solid; 50 | padding:10px; 51 | } 52 | 53 | .soft-table .col1 { 54 | background-color:#E4EEFF; 55 | font-weight:bold; 56 | text-align:left; 57 | } 58 | 59 | .soft-table .coln { 60 | background-color:#FFFCDC; 61 | } 62 | 63 | .soft-table .colnc { 64 | background-color:#FFFCDC; 65 | text-align:center; 66 | } -------------------------------------------------------------------------------- /Cheyenne/internal/rebol.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/rebol.gif -------------------------------------------------------------------------------- /Cheyenne/internal/si.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/internal/si.png -------------------------------------------------------------------------------- /Cheyenne/misc/admin.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Cheyenne Admin service" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.0 5 | Date: 01/12/2007 6 | ] 7 | 8 | install-service [ 9 | name: 'admin 10 | port-id: 10000 11 | scheme: 'udp 12 | verbose: 0 13 | 14 | on-raw-received: func [data][ 15 | if client/remote-ip <> 127.0.0.1 [exit] 16 | data: to string! data 17 | 18 | switch data/1 [ 19 | #"Q" [ 20 | if verbose > 0 [log/info "clean exit..."] 21 | uniserve/services/httpd/on-quit 22 | stop-events 23 | ] 24 | #"R" [ 25 | uniserve/services/httpd/on-reload 26 | ] 27 | #"W" [ 28 | uniserve/services/task-master/on-reset 29 | ] 30 | ] 31 | ] 32 | ] -------------------------------------------------------------------------------- /Cheyenne/misc/conf-parser.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | conf-parser: make log-class [ 4 | name: 'conf-parser 5 | verbose: 0 6 | 7 | location: folder: main-rules: string-rules: file-rules: 8 | global-rules: symbols: args: value: err: service: module: mode: 9 | vhost: scope: none 10 | 11 | cfg-file: %httpd.cfg 12 | 13 | sym-proto: [ 14 | 'globals global-rules 15 | 'main main-rules 16 | 'location string-rules 17 | 'folder file-rules 18 | ] 19 | 20 | reset: does [ 21 | main-rules: make block! 8 22 | string-rules: make block! 8 23 | file-rules: make block! 8 24 | global-rules: make block! 8 25 | symbols: reduce sym-proto 26 | recycle 27 | ] 28 | 29 | clean-rules: does [ 30 | foreach rule extract/index sym-proto 2 2 [ 31 | if all [ 32 | not empty? rule: get rule 33 | '| = last rule 34 | ][ 35 | remove back tail rule 36 | ] 37 | ] 38 | ] 39 | 40 | host-rules: [ 41 | scope: 42 | any [err: (mode: 'main) main-rules] 43 | any [ 44 | err: set location string! (mode: 'location) into [any string-rules] 45 | | set folder file! (mode: 'folder) into [any file-rules] 46 | ] 47 | ] 48 | 49 | conf-rule: [ 50 | err: 'globals (mode: 'globals) into [any [err: global-rules]] 51 | some [set vhost [word! | tuple! | url! | string!] into host-rules] 52 | ] 53 | 54 | read: func [svc /local word rules name list file conf data][ 55 | reset 56 | service: svc 57 | foreach [word rules] symbols [ 58 | if all [not empty? rules '| = last rules][ 59 | remove back tail rules 60 | ] 61 | ] 62 | file: either slash = first cfg-file [cfg-file][ 63 | cheyenne/data-dir/:cfg-file 64 | ] 65 | conf: load either exists? file [file][ 66 | either encap? [ 67 | data: as-string read-cache cfg-file 68 | write file data 69 | data 70 | ][ 71 | cfg-file ; -- local debug mode (not used in production) 72 | ] 73 | ] 74 | unless all [ 75 | 'modules = pick conf 1 76 | block? pick conf 2 77 | ][ 78 | throw 'invalid-conf-modules 79 | ] 80 | svc/mod-list: make block! 8 81 | foreach name conf/2 [ 82 | name: to-word join "mod-" name 83 | append svc/mod-list name 84 | file: join svc/mod-dir [name ".r"] 85 | if svc/verbose > 0 [log/info ["Loading extension: " mold :name]] 86 | append svc/mod-list do-cache file 87 | ] 88 | recycle 89 | clean-rules 90 | unless parse skip conf 2 conf-rule [ 91 | log/error ["error in conf file at:" mold/only copy/part err 5] 92 | ;throw 'invalid-conf-syntax 93 | ] 94 | service: none 95 | conf 96 | ] 97 | 98 | process: func [data [block!]][ 99 | parse data reduce ['any select symbols mode] 100 | ] 101 | 102 | add-rules: func [spec /local out word arg scope action][ 103 | unless parse spec [ 104 | any [ 105 | (out: make block! 16) 106 | set word set-word! ( 107 | append out to-lit-word word 108 | append out [(args: make block! 2)] 109 | ) 110 | any [ 111 | set arg block! ( 112 | repend out [ 113 | 'set 'value any [ 114 | all [1 = length? arg first arg] 115 | arg 116 | ] 117 | ] 118 | append out [(append/only args value)] 119 | ) 120 | | set arg lit-word! ( 121 | append out to-lit-word arg 122 | ) 123 | ] 124 | 'in set scope skip 125 | opt ['do set action block! ( 126 | repend out [to-paren bind action 'self] 127 | )]( 128 | scope: to-block scope 129 | foreach word scope [ 130 | repend select symbols word [out '|] 131 | ] 132 | ) 133 | ] 134 | ][ 135 | ;throw 'invalid-keyword-rule 136 | print "invalid keyword rule" 137 | ] 138 | ] 139 | ] -------------------------------------------------------------------------------- /Cheyenne/misc/debug-head.html: -------------------------------------------------------------------------------- 1 | 86 | -------------------------------------------------------------------------------- /Cheyenne/misc/debug-menu.rsp: -------------------------------------------------------------------------------- 1 | <% dbg-menu-offx: 265 %> 2 |
3 | 4 | 5 | 6 | 7 | <%unless empty? request/content [%> 8 | 9 | <%]%> 10 | <%if session/content [%> 11 | 12 | <%]%> 13 | 21 |
rsp debugrequestheadersparameterssession 14 | 15 | 16 | <%if rsp-error [%> 17 | 18 | <%]%> 19 | ? 20 |
22 |
23 | 35 | 41 | <%unless empty? request/content [%> 42 | 48 | <% dbg-menu-offx: 345 49 | ] 50 | if session/content [%> 51 | 59 | <%]%> 60 |
61 | 
<%=html-encode tail-file trace.log opts/lines%>
62 |
63 | <%if all [rsp-error opts-default/error = 'popup][%> 64 |
65 |

RSP Runtime Error

66 | 67 | 68 | 69 | 70 | 71 | 72 |
Script<%=mold rsp-error/src%>
Error Code<%=rsp-error/code%>
Description<%=system/error/(rsp-error/type)/type%> : <%=reform rsp-error/desc%>
Near<%=mold rsp-error/near%>
Where<%=mold rsp-error/where%>
73 |
74 | <%]%> 75 | 76 |
77 | -------------------------------------------------------------------------------- /Cheyenne/misc/macosx.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | make-null-string!: func [len [integer!]][ 4 | head insert/dup make string! len null len 5 | ] 6 | 7 | either all [value? 'access-os native? :access-os][ 8 | set 'set-uid func [uid][attempt [access-os/set 'uid uid true]] 9 | set 'set-gid func [gid][attempt [access-os/set 'gid gid true]] 10 | set 'chown func [ 11 | path [string!] 12 | owner [integer!] 13 | group [integer!] 14 | ][ 15 | path: to-rebol-file path 16 | set-modes path [owner-id: owner group-id: group] 17 | any [ 18 | all [ 19 | owner = get-modes path 'owner-id 20 | group = get-modes path 'group-id 21 | 0 22 | ] 23 | 1 24 | ] 25 | ] 26 | set 'kill-app func [pid][access-os/set 'pid pid] ; SIGTERM 27 | set 'process-id? does [access-os 'pid] 28 | ][ 29 | all [ 30 | libc: load/library %libc.dylib 31 | _setenv: make routine! [ 32 | name [string!] 33 | value [string!] 34 | overwrite [integer!] 35 | return: [integer!] 36 | ] libc "setenv" 37 | set 'set-env func [name [string!] value [string!]][ 38 | _setenv name value 1 39 | ] 40 | 41 | get-pid: make routine! [return: [integer!]] libc "getpid" 42 | 43 | _set-uid: make routine! [uid [integer!] return: [integer!]] libc "setuid" 44 | _set-gid: make routine! [gid [integer!] return: [integer!]] libc "setgid" 45 | 46 | set 'set-uid func [uid][zero? _set-uid uid] 47 | set 'set-gid func [gid][zero? _set-gid gid] 48 | 49 | set 'chown make routine! [ 50 | path [string!] 51 | owner [integer!] 52 | group [integer!] 53 | return: [integer!] 54 | ] libc "chown" 55 | 56 | set 'kill make routine! [ 57 | pid [integer!] 58 | sig [integer!] 59 | return: [integer!] 60 | ] libc "kill" 61 | 62 | set 'kill-app func [pid][ 63 | kill pid 15 ; SIGTERM 64 | ] 65 | 66 | set 'process-id? does [get-pid] 67 | ] 68 | ] 69 | 70 | set 'launch-app func [cmd [string!] /local ret][ 71 | ret: call/info cmd 72 | reduce ['OK ret/id] 73 | ] 74 | 75 | 76 | set 'list-listen-ports has [buffer out value][ 77 | buffer: make string! 10000 78 | call/output "netstat -f inet -p tcp -na" buffer 79 | out: make block! 10 80 | parse/all buffer [ 81 | 2 [thru newline] ;-- skip header lines 82 | any [ 83 | thru "*." [ 84 | #"*" | copy value to #" " ( 85 | if not find out value: to-integer value [append out value] 86 | ) 87 | ] 88 | ] 89 | ] 90 | sort out 91 | ] 92 | -------------------------------------------------------------------------------- /Cheyenne/misc/mime.types: -------------------------------------------------------------------------------- 1 | application/andrew-inset ez 2 | application/mac-binhex40 hqx 3 | application/mac-compactpro cpt 4 | application/msword doc 5 | application/octet-stream bin dms lha lzh class dmg 6 | application/x-msdos-program exe 7 | application/oda oda 8 | application/pdf pdf 9 | application/postscript ai eps ps 10 | application/smil smi smil 11 | application/vnd.google-earth.kml+xml kml 12 | application/vnd.google-earth.kmz kmz 13 | application/vnd.mif mif 14 | application/vnd.ms-excel xls 15 | application/vnd.ms-powerpoint ppt 16 | application/vnd.wap.wbxml wbxml 17 | application/vnd.wap.wmlc wmlc 18 | application/vnd.wap.wmlscriptc wmlsc 19 | application/x-bcpio bcpio 20 | application/x-cdlink vcd 21 | application/x-chess-pgn pgn 22 | application/x-cpio cpio 23 | application/x-csh csh 24 | application/x-director dcr dir dxr 25 | application/x-dvi dvi 26 | application/x-futuresplash spl 27 | application/x-gtar gtar 28 | application/x-hdf hdf 29 | application/x-javascript js 30 | application/x-koan skp skd skt skm 31 | application/x-latex latex 32 | application/x-netcdf nc cdf 33 | application/x-quicktimeplayer qtl 34 | application/x-sh sh 35 | application/x-shar shar 36 | application/x-shockwave-flash swf 37 | application/x-stuffit sit 38 | application/x-sv4cpio sv4cpio 39 | application/x-sv4crc sv4crc 40 | application/x-tar tar 41 | application/x-tcl tcl 42 | application/x-tex tex 43 | application/x-texinfo texinfo texi 44 | application/x-troff t tr roff 45 | application/x-troff-man man 46 | application/x-troff-me me 47 | application/x-troff-ms ms 48 | application/x-ustar ustar 49 | application/x-wais-source src 50 | application/x-rip rip 51 | application/zip zip 52 | application/json json 53 | audio/basic au snd 54 | audio/midi mid midi kar 55 | audio/mpeg mpga mp2 mp3 56 | audio/x-aiff aif aiff aifc 57 | audio/x-pn-realaudio ram rm 58 | audio/x-pn-realaudio-plugin rpm 59 | audio/x-realaudio ra 60 | audio/x-wav wav 61 | chemical/x-pdb pdb 62 | chemical/x-xyz xyz 63 | image/bmp bmp 64 | image/gif gif 65 | image/ief ief 66 | image/jpeg jpeg jpg jpe 67 | image/png png 68 | image/tiff tiff tif 69 | image/vnd.wap.wbmp wbmp 70 | image/x-cmu-raster ras 71 | image/x-icon ico 72 | image/x-portable-anymap pnm 73 | image/x-portable-bitmap pbm 74 | image/x-portable-graymap pgm 75 | image/x-portable-pixmap ppm 76 | image/x-rgb rgb 77 | image/x-xbitmap xbm 78 | image/x-xpixmap xpm 79 | image/x-xwindowdump xwd 80 | image/x-quicktime qti qtif 81 | image/x-macpaint pntg 82 | image/svg+xml svg 83 | model/iges igs iges 84 | model/mesh msh mesh silo 85 | model/vrml wrl vrml 86 | text/css css 87 | text/html html htm 88 | text/plain asc txt 89 | text/richtext rtx 90 | text/rtf rtf 91 | text/sgml sgml sgm 92 | text/tab-separated-values tsv 93 | text/vnd.wap.wml wml 94 | text/vnd.wap.wmlscript wmls 95 | text/x-setext etx 96 | text/xml xml 97 | video/mpeg mpeg mpg mpe 98 | video/quicktime qt mov 99 | video/x-msvideo avi 100 | video/x-sgi-movie movie 101 | x-conference/x-cooltalk ice 102 | 103 | -------------------------------------------------------------------------------- /Cheyenne/misc/os.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | OS-ctx: make log-class [ 4 | name: 'OS 5 | verbose: 0 6 | 7 | sys: none 8 | 9 | either any [ 10 | find system/components 'library ;-- /Library present? 11 | all [value? 'access-os native? :access-os] ;-- 'access-os native present? 12 | ][ 13 | sys: make log-class [name: 'OS-API verbose: 2] 14 | sys: make sys load-cache switch system/version/4 [ 15 | 2 [%misc/macosx.r] 16 | 3 [%misc/win32.r] 17 | 4 [%misc/unix.r] 18 | ] 19 | ][ ; === /Library component not available, minimal setup === 20 | 21 | set 'launch-app func [cmd [string!] /local ret][ 22 | ret: call/info cmd 23 | reduce ['OK ret/id] 24 | ] 25 | set 'kill-app func [pid][ 26 | either system/version/4 = 3 [ 27 | log/warn "cannot kill external app" 28 | ][ 29 | call join "kill " pid 30 | ] 31 | ] 32 | set [set-env process-id? NT-Service? list-listen-ports] none 33 | set [set-uid set-gid chown] 0 ;-- 0 is the OK result 34 | ] 35 | ] 36 | 37 | -------------------------------------------------------------------------------- /Cheyenne/misc/service.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/misc/service.dll -------------------------------------------------------------------------------- /Cheyenne/misc/system.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | ;--- TBD: trap errors ! 4 | 5 | make log-class [ 6 | name: 'system 7 | verbose: 0 8 | 9 | sys: system-awake: modes: none 10 | 11 | events: normal-events: [ 12 | run-as [ 13 | if system/options/home = OS-get-dir 'desktop [ 14 | append cheyenne/sub-args " -fromdesk" 15 | ] 16 | either install-NT-service [ 17 | uniserve/services/httpd/on-quit 18 | cheyenne/on-quit 19 | uniserve/control/shutdown 20 | control-service/start 21 | launch/quit cheyenne/sub-args 22 | ][ 23 | alert "ERROR : installing a service requires Administrator rights!" 24 | ] 25 | ] 26 | reload [ 27 | uniserve/services/httpd/on-reload 28 | ] 29 | reset [ 30 | uniserve/services/task-master/on-reset 31 | ] 32 | quit [ 33 | uniserve/services/httpd/on-quit 34 | cheyenne/on-quit 35 | close sys 36 | uniserve/flag-stop: on 37 | quit 38 | ] 39 | ] 40 | 41 | remote-events: [ 42 | run-as [ 43 | if NT-service-running? [control-service/stop] 44 | uninstall-NT-service 45 | wait 1 46 | launch/quit cheyenne/sub-args 47 | ] 48 | reload [ 49 | write/direct/no-wait udp://127.0.0.1:10000 "R" 50 | ] 51 | reset [ 52 | write/direct/no-wait udp://127.0.0.1:10000 "W" 53 | ] 54 | quit [ 55 | close sys 56 | throw 'quit 57 | ] 58 | ] 59 | 60 | remote-mode: [ 61 | tray: [ 62 | add main [ 63 | help: "Cheyenne is running" 64 | menu: [ 65 | ; about: "About..." 66 | run-as: "Run as user application" 67 | bar 68 | reload: "Reload Config" 69 | reset: "Reset Workers" 70 | bar 71 | quit: "Quit" 72 | ] 73 | ] 74 | ] 75 | ] 76 | 77 | set 'set-tray-remote-events does [ 78 | events: remote-events 79 | set-modes sys remote-mode 80 | ] 81 | 82 | set 'set-tray-help-msg func [msg [string!]][ 83 | modes/(to-set-word 'tray)/main/2: msg 84 | remote-mode/(to-set-word 'tray)/main/2: msg 85 | ] 86 | 87 | do-action: func [evt][ 88 | if verbose > 0 [log/info ["event received: " mold evt]] 89 | switch evt events 90 | ] 91 | 92 | either system/version/4 = 3 [ 93 | ;--- Windows platforms 94 | system-awake: func [port /local evt][ 95 | if all [ 96 | evt: pick port 1 97 | evt/1 = 'tray 98 | evt/3 = 'menu 99 | ][ 100 | do-action evt/4 101 | ] 102 | false 103 | ] 104 | modes: [ 105 | tray: [ 106 | add main [ 107 | help: "Cheyenne is running" 108 | menu: [ 109 | ; about: "About..." 110 | run-as: "Run as service" 111 | bar 112 | reload: "Reload Config" 113 | reset: "Reset Workers" 114 | bar 115 | quit: "Quit" 116 | ] 117 | ] 118 | ] 119 | ] 120 | ][ 121 | ;--- All others platforms 122 | system-awake: func [port /local evt][ 123 | evt: pick port 1 124 | if verbose > 0 [ 125 | log/info ["raw event:" mold evt] 126 | ] 127 | if evt: select evt 'signal [ 128 | do-action select [ 129 | sighup reload 130 | sigusr1 reset 131 | sigint quit 132 | sigquit quit 133 | sigterm quit 134 | ] evt 135 | ] 136 | false 137 | ] 138 | modes: [ 139 | signal: [sighup sigusr1 sigint sigquit sigterm] 140 | ] 141 | ] 142 | 143 | set 'open-system-events does [ 144 | sys: system/ports/system: open [scheme: 'system] 145 | append system/ports/wait-list sys 146 | sys/awake: :system-awake 147 | set-modes sys modes 148 | ] 149 | ] 150 | -------------------------------------------------------------------------------- /Cheyenne/misc/unix.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | either all [value? 'access-os native? :access-os][ 4 | set 'set-uid func [uid][attempt [access-os/set 'uid uid true]] 5 | set 'set-gid func [gid][attempt [access-os/set 'gid gid true]] 6 | set 'chown func [ 7 | path [string!] 8 | owner [integer!] 9 | group [integer!] 10 | ][ 11 | path: to-rebol-file path 12 | set-modes path [owner-id: owner group-id: group] 13 | any [ 14 | all [ 15 | owner = get-modes path 'owner-id 16 | group = get-modes path 'group-id 17 | 0 18 | ] 19 | 1 20 | ] 21 | ] 22 | set 'kill-app func [pid][access-os/set 'pid pid] ; SIGTERM 23 | set 'process-id? does [access-os 'pid] 24 | ][ 25 | all [ 26 | any [ 27 | exists? libc: %libc.so.6 28 | exists? libc: %/lib32/libc.so.6 29 | exists? libc: %/lib/libc.so.6 30 | exists? libc: %/System/Index/lib/libc.so.6 ; GoboLinux package 31 | exists? libc: %/system/index/framework/libraries/libc.so.6 ; Syllable 32 | exists? libc: %/lib/libc.so.5 33 | ] 34 | libc: load/library libc 35 | _setenv: make routine! [ 36 | name [string!] 37 | value [string!] 38 | overwrite [integer!] 39 | return: [integer!] 40 | ] libc "setenv" 41 | 42 | get-pid: make routine! [return: [integer!]] libc "getpid" 43 | 44 | set 'set-env func [name [string!] value [string!]][ 45 | _setenv name value 1 46 | ] 47 | _set-uid: make routine! [uid [integer!] return: [integer!]] libc "setuid" 48 | _set-gid: make routine! [gid [integer!] return: [integer!]] libc "setgid" 49 | 50 | set 'set-uid func [uid][zero? _set-uid uid] 51 | set 'set-gid func [gid][zero? _set-gid gid] 52 | 53 | set 'chown make routine! [ 54 | path [string!] 55 | owner [integer!] 56 | group [integer!] 57 | return: [integer!] 58 | ] libc "chown" 59 | 60 | set 'kill make routine! [ 61 | pid [integer!] 62 | sig [integer!] 63 | return: [integer!] 64 | ] libc "kill" 65 | 66 | set 'kill-app func [pid][ 67 | kill pid 15 ; SIGTERM 68 | ] 69 | 70 | set 'process-id? does [get-pid] 71 | ] 72 | ] 73 | 74 | set 'launch-app func [cmd [string!] /local ret][ 75 | ret: call/info cmd 76 | reduce ['OK ret/id] 77 | ] 78 | 79 | tcp-states: [ 80 | ESTABLISHED 81 | SYN_SENT 82 | SYN_RECEIVED 83 | FIN_WAIT_1 84 | FIN_WAIT_2 85 | TIME_WAIT 86 | CLOSED 87 | CLOSE_WAIT 88 | LAST_ACK 89 | LISTEN 90 | CLOSING 91 | ] 92 | 93 | set 'list-listen-ports has [p out value state][ 94 | p: open/read/lines %/proc/net/tcp 95 | out: make block! length? p 96 | p: next p ;-- skip column names line 97 | until [ 98 | parse/all first p [ 99 | thru ": " thru #":" copy value to #" " 100 | thru #":" thru #" " copy state to #" " 101 | ] 102 | state: pick tcp-states to integer! debase/base state 16 103 | if all [ 104 | state = 'LISTEN 105 | not find out value: to integer! debase/base value 16 106 | ][ 107 | append out value 108 | ] 109 | tail? p: next p 110 | ] 111 | close p 112 | sort out 113 | ] 114 | -------------------------------------------------------------------------------- /Cheyenne/mods/mod-action.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-action 5 | 6 | order: [ 7 | set-mime-type normal 8 | access-check normal 9 | make-response normal 10 | reform-headers normal 11 | logging last 12 | task-done last 13 | task-failed last 14 | ] 15 | 16 | dyn-types: make block! 8 17 | 18 | declined?: func [req][not select dyn-types req/in/ext] 19 | 20 | on-reload: does [ 21 | clear dyn-types 22 | ] 23 | 24 | set-mime-type: func [req][ 25 | if declined? req [return none] 26 | req/out/mime: 'text/html 27 | true 28 | ] 29 | 30 | access-check: func [req /local info mdate][ 31 | ; --- This phase is redefined to avoid Last-Modified header generation 32 | ; --- from mod-static (inappropriate here) 33 | 34 | if declined? req [return none] 35 | 36 | ; --- Test if the file can be read by Uniserve 37 | unless req/file-info: info? req/in/file [ 38 | req/out/code: 400 39 | ] 40 | true 41 | ] 42 | 43 | make-response: func [req /local mod msg][ 44 | ; --- Decline unless dynamic type 45 | unless mod: select dyn-types req/in/ext [return none] 46 | 47 | service/module: mod 48 | msg: remold [ 49 | to lit-word! 'cfg req/cfg 50 | to lit-word! 'in req/in 51 | to lit-word! 'ip service/client/remote-ip 52 | to lit-word! 'port service/client/local-port 53 | ] 54 | service/do-task msg req 55 | true 56 | ] 57 | 58 | reform-headers: func [req /local roh][ 59 | if declined? req [return none] 60 | 61 | if req/out/code = 200 [ 62 | roh: req/out/headers 63 | unless find roh 'Cache-Control [ 64 | ;h-store roh 'Cache-Control "private, max-age=0" 65 | h-store roh 'Cache-Control "no-cache, no-store, max-age=0, must-revalidate" 66 | ] 67 | unless find roh 'Pragma [ 68 | h-store roh 'Pragma "no-cache" 69 | ] 70 | unless find roh 'Expires [ 71 | h-store roh 'Expires "-1" 72 | ] 73 | false 74 | ] 75 | ] 76 | 77 | logging: func [req][ 78 | none 79 | ] 80 | 81 | task-done: func [req /local res value data][ 82 | data: req/out/content 83 | 84 | either "HTTP" = copy/part data 4 [ 85 | ;--- Non Parsed Header output --- 86 | ; TBD: test this code branch 87 | req/out/header-sent?: yes 88 | ][ 89 | ;--- Parsed Header output --- 90 | res: service/parse-headers data req/out 91 | either first res [ 92 | unless empty? data [ 93 | if cr = first res/2 [data: skip res/2 2] 94 | if lf = first res/2 [data: next res/2] 95 | req/out/content: copy data 96 | ] 97 | ][ 98 | req/out/content: "CGI Headers Error" 99 | ] 100 | any [ 101 | all [ 102 | value: select req/out/headers 'Status 103 | req/out/status-line: rejoin [ 104 | "HTTP/1.1 " trim/tail value crlf 105 | ] 106 | h-store req/out/headers 'Status none 107 | ] 108 | all [ 109 | select req/out/headers 'Location 110 | req/out/code: 302 111 | ] 112 | req/out/code: 200 113 | ] 114 | ] 115 | service/process-queue 116 | true 117 | ] 118 | 119 | task-failed: func [req][ 120 | req/out/code: 500 121 | service/process-queue 122 | true 123 | ] 124 | 125 | words: [ 126 | ;--- associate a file extension with an external handler for bg processing 127 | bind-extern: [word!] 'to [word! | block!] in globals do [ 128 | use [data][ 129 | foreach ext to-block args/2 [ 130 | data: reduce [ext args/1] 131 | append service/mod-list/mod-action/dyn-types data 132 | append service/handlers data 133 | ] 134 | ] 135 | ] 136 | 137 | ;--- list libraries to be loaded by workers processes 138 | worker-libs: [block!] in globals 139 | 140 | ;--- allow domain or application specific local parameters (free-form content) 141 | locals: [block!] in main 142 | 143 | ;-- switches REBOL CGI scripts to FastCGI-like mode 144 | fast-rebol-cgi: in main 145 | ] 146 | ] -------------------------------------------------------------------------------- /Cheyenne/mods/mod-alias.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-alias 5 | 6 | order: [ 7 | url-to-filename first 8 | ] 9 | 10 | redirects: make hash! 32 11 | aliases: make hash! 32 12 | 13 | url-to-filename: func [req /local list pattern action url ext][ 14 | ; --- Test matching virtual host 15 | if list: select redirects req/vhost [ 16 | ; -- Test matching patterns on request path 17 | url: join req/in/path req/in/target 18 | foreach [pattern action] list [ 19 | if find/any/match url pattern [ 20 | req/out/code: second action 21 | if slash = last url: first action [ 22 | insert tail url: copy url join req/in/target any [req/in/arg ""] 23 | ] 24 | h-store req/out/headers 'Location url 25 | return true 26 | ] 27 | ] 28 | ] 29 | if list: select aliases req/vhost [ 30 | foreach [pattern action] list [ 31 | if find/any/match req/in/url pattern [ 32 | req/in/file: rejoin [req/cfg/root-dir slash action] ;-- make a smart rejoin!!! 33 | req/in/script-name: copy pattern 34 | if ext: find/last action #"." [ 35 | req/in/ext: to word! as-string ext 36 | req/handler: select service/handlers req/in/ext 37 | ] 38 | ;req/handler: select service/handlers to word! as-string suffix? action 39 | return false ;-- let mod-static finish the work 40 | ] 41 | ] 42 | ] 43 | false 44 | ] 45 | 46 | words: [ 47 | alias: [string!] [file!] in main do [ 48 | use [list pos][ 49 | list: service/mod-list/mod-alias/aliases 50 | unless pos: select list vhost [ 51 | repend list [vhost pos: copy []] 52 | ] 53 | repend pos [args/1 args/2] 54 | ] 55 | ] 56 | redirect: [integer!] [string!] [string!] in main do [ 57 | use [list pos][ 58 | list: service/mod-list/mod-alias/redirects 59 | unless pos: select list vhost [ 60 | repend list [vhost pos: copy []] 61 | ] 62 | repend pos [args/2 reduce [args/3 args/1]] 63 | ] 64 | ] 65 | ] 66 | ] -------------------------------------------------------------------------------- /Cheyenne/mods/mod-cors.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Mod CORS" 3 | Purpose: "CORS support for Cheyenne" 4 | File: %mod-cors.r 5 | Author: "Nenad Rakocevic" 6 | Date: 01/08/2013 7 | Note: "Work sponsored by Alan MacLeod" 8 | ] 9 | 10 | install-HTTPd-extension [ 11 | name: 'mod-cors 12 | 13 | order: [ 14 | method-support first 15 | access-check first 16 | ] 17 | 18 | rules: make block! 2 19 | 20 | match-host?: func [host origin /local spec][ 21 | origin: any [ 22 | find/match origin "http://" ;-- skip the http prefix 23 | origin 24 | ] 25 | all [ 26 | spec: select rules host 27 | any [ 28 | spec/1 = '* 29 | spec: select spec origin 30 | ] 31 | spec 32 | ] 33 | ] 34 | 35 | on-reload: does [ 36 | clear rules 37 | ] 38 | 39 | method-support: func [req][ 40 | if find req/in/headers 'Origin [return true] ;-- passthru for HTTP methods 41 | none 42 | ] 43 | 44 | access-check: func [req /local url spec ri ro list req-method headers][ 45 | ri: req/in/headers 46 | if all [ 47 | url: select ri 'Origin 48 | spec: match-host? req/vhost url 49 | ][ 50 | ro: req/out/headers 51 | h-store ro 'Access-Control-Allow-Origin url 52 | 53 | either req/in/method = 'OPTIONS [ ;-- preflight request 54 | 55 | if req-method: select ri 'Access-Control-Request-Method [ 56 | list: any [ 57 | select spec 'methods 58 | [GET HEAD POST PUT DELETE] ;-- default allowed method if no restriction 59 | ] 60 | buf: make string! 10 61 | foreach method list [ 62 | insert tail buf form method 63 | insert tail buf ", " 64 | ] 65 | clear back back tail buf 66 | h-store ro 'Access-Control-Allow-Methods buf 67 | ] 68 | if headers: select ri 'Access-Control-Request-Headers [ 69 | h-store ro 'Access-Control-Allow-Headers headers 70 | ] 71 | req/out/code: 200 72 | req/out/content: "Preflight request accepted" ;-- avoids "no content" catching 73 | return true 74 | ][ ;-- simple request 75 | if find spec 'cookies [ 76 | h-store ro 'Access-Control-Allow-Credentials "true" 77 | ] 78 | if list: select spec 'headers [ 79 | foreach h list [ 80 | h-store ro 'Access-Control-Expose-Headers form h 81 | ] 82 | ] 83 | return false 84 | ] 85 | ] 86 | none 87 | ] 88 | 89 | words: [ 90 | allow-cors: [block!] 'from ['* | string! | word!] in main do [ 91 | use [rules list][ 92 | rules: service/mod-list/mod-cors/rules 93 | unless list: select rules vhost [ 94 | repend rules [vhost list: make block! 2] 95 | ] 96 | either args/2 = '* [ 97 | insert list reduce ['* args/1] 98 | ][ 99 | repend list [form args/2 args/1] 100 | ] 101 | ] 102 | ] 103 | ] 104 | ] -------------------------------------------------------------------------------- /Cheyenne/mods/mod-embed.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | do-cache uniserve-path/libs/decode-cgi.r 4 | 5 | install-HTTPd-extension [ 6 | name: 'mod-embed 7 | 8 | ;-- Take precedence over any other module 9 | order: [ 10 | url-translate first 11 | url-to-filename first 12 | parsed-headers first 13 | method-support first 14 | filter-input first 15 | access-check first 16 | filter-output first 17 | reform-headers first 18 | logging first 19 | clean-up first 20 | ] 21 | 22 | ;-- Disable all other phases 23 | method-support: 24 | url-translate: 25 | url-to-filename: 26 | parsed-headers: 27 | filter-input: 28 | filter-output: 29 | reform-headers: 30 | logging: 31 | clean-up: func [req][true] 32 | 33 | site: params: none 34 | 35 | set 'publish-site func [spec [block!]][ 36 | site: context spec 37 | ] 38 | 39 | access-check: func [req /local node name target result][ 40 | params: decode-params req 41 | if in site 'on-request [ 42 | if site/on-request req params service [return true] 43 | ] 44 | node: site 45 | parse next req/in/path [ 46 | any [copy name to "/" skip ( 47 | name: to word! name 48 | unless in node :name [break] 49 | node: node/:name 50 | )] 51 | ] 52 | target: any [ 53 | all [ 54 | req/in/target 55 | not empty? req/in/target 56 | attempt [target: to word! req/in/target] 57 | function? get in node :target 58 | in node :target 59 | ] 60 | 'default 61 | ] 62 | 63 | if error? result: try [node/:target req params service][ 64 | result: mold disarm result 65 | ] 66 | req/out/content: form any [result ""] 67 | if in site 'on-response [site/on-response req params service] 68 | true 69 | ] 70 | 71 | words: [] 72 | 73 | ; === Helper functions === 74 | 75 | ;-- quick implementation of multipart decoding : 76 | ; - doesn't support multipart/mixed encoding yet 77 | ; - doesn't parse all optional headers 78 | 79 | decode-multipart: func [data /local bound list name filename value pos][ 80 | parse/all data/in/headers/Content-type [ 81 | thru "boundary=" opt dquote copy bound [to dquote | to end] 82 | ] 83 | unless bound [return ""] ;-- add proper error handler 84 | insert bound "--" 85 | list: make block! 2 86 | parse/all data/in/content [ 87 | some [ 88 | bound nl some [ 89 | thru {name="} copy name to dquote skip 90 | [#";" thru {="} copy filename to dquote | none] 91 | thru crlfx2 copy value to bound ( 92 | clear back back tail value ; -- delete ending crlf (watch out for cr or lf only!!) 93 | insert tail list name 94 | either filename [ 95 | insert/only tail list reduce [filename value] 96 | ][ 97 | insert tail list value 98 | ] 99 | filename: none 100 | ) | "--" 101 | ] 102 | ] 103 | ] 104 | list 105 | ] 106 | 107 | decode-params: func [req /local list][ 108 | list: any [ 109 | switch req/in/method [ 110 | GET [ 111 | all [ 112 | req/in/arg 113 | clear find/last req/in/arg #"#" 114 | ] 115 | req/in/arg 116 | ] 117 | POST [ 118 | either all [ 119 | type: select req/in/headers 'Content-type 120 | find/part type "multipart/form-data" 19 121 | ][ 122 | decode-multipart req/in/content 123 | ][ 124 | req/in/content 125 | ] 126 | ] 127 | ] 128 | "" 129 | ] 130 | if any-string? list [list: decode-cgi list] ; TBD: optimize decode-cgi 131 | while [not tail? list][ 132 | poke list 1 to word! first list 133 | list: skip list 2 134 | ] 135 | head list 136 | ] 137 | ] -------------------------------------------------------------------------------- /Cheyenne/mods/mod-expire.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | date: 21-Dec-2008 3 | version: .03 4 | author: {Will Arp} 5 | ] 6 | 7 | ; --- 8 | ; add 'expires in httpd.cfg/modules 9 | ; put something like this in httpd.cfg/globals 10 | ; 11 | ; expires [ 12 | ; image/x-icon 604800 ;time to cache in seconds 13 | ; image/gif 604800 14 | ; image/jpeg 604800 15 | ; 16 | ; text/html 600 17 | ; text/css 600 18 | ; application/x-javascript 600 19 | ; ] 20 | ; --- 21 | 22 | 23 | install-HTTPd-extension [ 24 | name: 'mod-expire 25 | 26 | order: [ 27 | reform-headers last 28 | ;change to first if you want expires applied to rsp, 29 | ;then you will have to explicitly negate caching in 30 | ;your script if needed, as mod-action will set no 31 | ;caching by default. 32 | ] 33 | 34 | expires: none 35 | 36 | reform-headers: func [req /local time seconds roh][ 37 | all [ 38 | expires 39 | roh: req/out/headers 40 | not find roh 'Expires 41 | seconds: select/only expires req/out/mime 42 | time: now 43 | h-store req/out/headers 'Expires to-GMT-idate/UTC (time + to time! seconds) 44 | ;http://blog.pluron.com/2008/07/why-you-should.html 45 | h-store req/out/headers 'Cache-Control rejoin ["public, max-age=" seconds] 46 | not find roh 'Last-Modified 47 | h-store req/out/headers 'Last-Modified to-GMT-idate/UTC time 48 | ] 49 | false 50 | ] 51 | 52 | words: [ 53 | expires: [block!] in [globals] do [ 54 | expires: to hash! args/1 55 | ] 56 | ] 57 | ] 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | -------------------------------------------------------------------------------- /Cheyenne/mods/mod-extapp.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-extapp 5 | verbose: 0 6 | 7 | extapp!: context [name: instances: jobs: balancing: specs: none] 8 | app!: context [pid: ports: none] 9 | 10 | templates: make block! 1 ; [[spec] ...] 11 | actives: make block! 1 ; [name extapp! ...] 12 | ;-- extapp/jobs specs: [timestamp req client state ...] 13 | 14 | round-robin: func [list /local idx][ 15 | idx: [-1] 16 | pick list 1 + idx/1: remainder idx/1 + 1 length? list 17 | ] 18 | 19 | launch-servers: has [cmd chan ret new n v delay][ 20 | foreach spec templates [ 21 | parse spec [ 22 | some [ 23 | 'environment into [ 24 | any [set n skip set v skip (set-env form n form v)] 25 | ] 26 | | 'command set cmd string! 27 | | 'channels set chan integer! 28 | | skip 29 | ] 30 | ] 31 | new: make extapp! [ 32 | name: spec/name 33 | jobs: make block! 8 34 | instances: make block! 1 35 | get-balanced: either chan [:round-robin][:first] 36 | specs: spec 37 | ] 38 | either cmd [ 39 | ret: launch-app cmd 40 | either ret/1 = 'ok [ 41 | new/instances: all [ 42 | cmd ret/1 = 'ok 43 | reduce [make app! [pid: ret/2]] 44 | ] 45 | if number? delay: select spec 'delay [ 46 | scheduler/stop 47 | wait delay 48 | scheduler/start 49 | ] 50 | ][ 51 | log/error reform [ 52 | "cannot launch :" cmd newline 53 | "OS message:" trim form ret/2 54 | ] 55 | ] 56 | ][ 57 | new/instances: reduce [make app! []] 58 | ] 59 | repend actives [spec/name new] 60 | ] 61 | ] 62 | 63 | kill-servers: does [ 64 | foreach [name extapp] actives [ 65 | foreach app extapp/instances [ 66 | if app/pid [ 67 | kill-app app/pid 68 | if verbose > 0 [log/info reform [name "killed"]] 69 | ] 70 | ] 71 | ] 72 | ] 73 | 74 | set 'extapp-register func [ 75 | scheme [word!] 76 | evt [block!] 77 | /with defs [block!] 78 | /local out url delay app 79 | ][ 80 | out: make block! 1 81 | foreach [name extapp] actives [ 82 | if all [ 83 | url: select extapp/specs 'url 84 | scheme = get in parse-url url 'scheme 85 | ][ 86 | foreach app extapp/instances [ 87 | ctx: service/client 88 | defs: repend any [defs make block! 2][ 89 | to-set-word 'job-queue none 90 | to-set-word 'connect-retry 3 91 | to-set-word 'stats none 92 | ] 93 | loop any [select extapp/specs 'channels 1][ 94 | port: open-port/with select extapp/specs 'url evt defs 95 | port/job-queue: make block! 64 96 | port/stats: copy [0 0] ; [req-nb out-size] 97 | service/set-peer ctx 98 | either app/ports [ 99 | append app/ports port 100 | ][ 101 | app/ports: reduce [port] 102 | ] 103 | ] 104 | ] 105 | append out name 106 | ] 107 | ] 108 | out 109 | ] 110 | 111 | set 'extapp-pop-job func [list /local extapp jobs sel][ 112 | foreach name list [ 113 | if all [ 114 | extapp: select actives name 115 | not empty? extapp/jobs 116 | ][ 117 | jobs: extapp/jobs 118 | sel: none 119 | while [not empty? jobs][ 120 | either jobs/1/4 = 'pending [ 121 | either closed-port? jobs/1/3 [ 122 | remove jobs 123 | ][ 124 | if not sel [sel: jobs/1] 125 | jobs: next jobs 126 | ] 127 | ][ 128 | return none 129 | ] 130 | ] 131 | if sel [return sel] 132 | ] 133 | ] 134 | none 135 | ] 136 | 137 | set 'extapp-clear-job func [job id][ 138 | extapp: select actives id 139 | ;print ["jobs:" length? extapp/jobs] 140 | remove find/only extapp/jobs job 141 | ;print ["jobs:" length? extapp/jobs] 142 | ] 143 | 144 | set 'extapp-make-job func [ 145 | req [object!] 146 | /local extapp app job port 147 | ][ 148 | job: reduce [ 149 | now/precise 150 | req 151 | service/client 152 | 'pending 153 | ] 154 | all [ 155 | any [ 156 | extapp: select actives req/handler 157 | all [log/error rejoin ["extapp" req/handler "not found"] false] 158 | ] 159 | all [ 160 | insert/only tail extapp/jobs job 161 | extapp/instances 162 | not empty? extapp/instances ;=> abort, launch extapp 163 | app: first extapp/instances 164 | ] 165 | all [ 166 | app/ports 167 | not empty? app/ports 168 | port: extapp/get-balanced app/ports 169 | all [ 170 | closed-port? port ;=> abort, reopen 171 | port: reopen-port port 172 | false 173 | ] 174 | not object? port/locals ; port is opening and is not ready yet 175 | port: none 176 | ] 177 | ] 178 | reduce [port job] 179 | ] 180 | 181 | on-started: func [svc][ 182 | launch-servers 183 | ] 184 | 185 | on-reload: func [svc][ 186 | kill-servers 187 | ] 188 | 189 | on-quit: func [svc][ 190 | kill-servers 191 | ] 192 | 193 | words: [ 194 | extern-app: [block!] in globals do [ 195 | append/only templates args/1 196 | ] 197 | ] 198 | ] 199 | -------------------------------------------------------------------------------- /Cheyenne/mods/mod-fastcgi.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-fastcgi 5 | 6 | order: [ 7 | url-to-filename first 8 | set-mime-type normal 9 | access-check normal 10 | make-response normal 11 | logging last 12 | ] 13 | 14 | dot: #"." 15 | seq-id: 1 16 | register-list: [] 17 | 18 | on-started: func [svc /local s ctx][ 19 | register-list: extapp-register/with 'fastcgi [ 20 | on-response: func [port data err /local jobs ctx req][ 21 | if series? data [port/stats/2: port/stats/2 + length? data] 22 | if err [log/warn err] 23 | jobs: find port/job-queue port/id 24 | ctx: service/client ; save current client port context 25 | service/set-peer jobs/2/3 26 | service/on-task-done data req: jobs/2/2 27 | extapp-clear-job jobs/2 req/handler 28 | remove/part jobs 2 29 | service/set-peer ctx ; restore saved client port context 30 | port/locals/handler/on-ready port 31 | ] 32 | on-error: func [data][log/error length? mold data] 33 | on-closed: func [port /local job][ 34 | foreach [id job] port/job-queue [job/4: 'pending] 35 | clear port/job-queue 36 | 37 | if all [ 38 | object? port/locals 39 | not empty? port/locals/write-queue 40 | ][ 41 | clear port/locals/write-queue 42 | ] 43 | reopen-port/no-close port 44 | ] 45 | on-ready: func [port][ 46 | if job: extapp-pop-job register-list [ 47 | send-job job/2 port job 48 | ] 49 | ] 50 | ][ 51 | id: none 52 | ] 53 | false 54 | ] 55 | 56 | ; --- Decline if not fastcgi script 57 | declined?: func [req][not find register-list req/handler] 58 | 59 | url-to-filename: func [req /local d? cfg domain ext new][ 60 | d?: declined? req 61 | cfg: req/cfg 62 | if empty? trim req/in/target [ ;-- trim should be done when target is parsed 63 | foreach file to-block any [select cfg 'default []][ 64 | new: rejoin [cfg/root-dir req/in/path file] 65 | if req/file-info: info? new [ 66 | req/in/target: form file 67 | if ext: find/last req/in/target dot [ 68 | req/in/ext: to word! ext 69 | req/handler: select service/handlers req/in/ext 70 | ] 71 | if not req/in/file [req/in/file: new] 72 | if d?: declined? req [return false] 73 | ] 74 | ] 75 | ] 76 | either d? [ 77 | false 78 | ][ 79 | if not req/in/file [ 80 | req/in/file: rejoin [cfg/root-dir req/in/path req/in/target] 81 | ] 82 | true 83 | ] 84 | ] 85 | 86 | set-mime-type: func [req][ 87 | if declined? req [return none] 88 | req/out/mime: 'text/html 89 | true 90 | ] 91 | 92 | access-check: func [req /local info mdate][ 93 | ; --- This phase is redefined to avoid Last-Modified header generation 94 | ; --- and 404 errors from mod-static (inappropriate here) 95 | 96 | if declined? req [return none] 97 | true 98 | ] 99 | 100 | send-job: func [req port job][ 101 | port/id: seq-id 102 | repend port/job-queue [seq-id job] 103 | 104 | port/stats/1: port/stats/1 + 1 105 | seq-id: seq-id // 5000 + 1 ;-- Limited to a smaller 16bits value (according to FCGI specs) 106 | 107 | insert-port port make fcgi-job-class [ 108 | id: port/id 109 | client: service/client 110 | url: join req/in/path req/in/target 111 | ;info: req/in/path 112 | path: form to-local-file get-modes req/in/file 'full-path 113 | script: any [req/in/script-name req/in/url] 114 | query: req/in/arg 115 | if req/auth/type [ 116 | auth-type: form req/auth/type 117 | user: req/auth/user 118 | ] 119 | headers: req/in/headers 120 | if content: req/in/content [ 121 | cnt-length: select req/in/headers 'Content-Length 122 | cnt-type: select req/in/headers 'Content-Type 123 | ] 124 | if req/in/method <> 'GET [method: form req/in/method] 125 | ] 126 | job/4: 'sent 127 | ] 128 | 129 | make-response: func [req /local port job][ 130 | if declined? req [return none] 131 | 132 | set [port job] extapp-make-job req 133 | 134 | if all [ 135 | port 136 | ;object? port/locals ; tested in mod-extapp 137 | empty? port/job-queue ; ?? empty is not accurate test, should test jobs flags, or port busy 138 | ][ 139 | send-job req port job 140 | ] 141 | true 142 | ] 143 | 144 | logging: func [req][ 145 | none 146 | ] 147 | 148 | words: [] 149 | ] 150 | -------------------------------------------------------------------------------- /Cheyenne/mods/mod-internal.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-internal 5 | 6 | order: [ 7 | url-to-filename first 8 | logging first 9 | ] 10 | 11 | allowed: [127.0.0.1] 12 | 13 | internal-conf: [ 14 | root-dir %internal 15 | default %index.rsp 16 | webapp [ 17 | virtual-root "/admin" 18 | root-dir %www/admin/ 19 | auth "/admin/login.rsp" 20 | debug 21 | ] 22 | ] 23 | 24 | clean: func [str /local s e][ 25 | parse/all str [ 26 | any [ 27 | s: [".." | #"%" | #"\" | slash | "@"] e: (remove/part s e) | skip 28 | ] 29 | ] 30 | str 31 | ] 32 | 33 | url-to-filename: func [req][ 34 | either all [ 35 | req/in/target 36 | req/in/path = "/" 37 | #"@" = pick req/in/target 1 38 | find allowed service/client/remote-ip 39 | ][ 40 | clean req/in/target 41 | req/cfg: internal-conf 42 | unless find req/in/target #"." [ 43 | req/in/target: join req/in/target ".rsp" 44 | req/handler: select service/handlers req/in/ext: '.rsp 45 | ] 46 | false 47 | ][none] 48 | ] 49 | 50 | logging: func [req][ 51 | either find req/in/url #"@" [true][none] 52 | ] 53 | 54 | words: [ 55 | admin-ip: [tuple! | block!] in globals do [allowed: to-block first args] 56 | ] 57 | ] -------------------------------------------------------------------------------- /Cheyenne/mods/mod-socket.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-socket 5 | verbose: 0 6 | 7 | order: [ 8 | socket-connect normal 9 | socket-message normal 10 | socket-disconnect normal 11 | ] 12 | 13 | apps: make block! 8 14 | mappings: make block! 8 15 | random/seed now/time/precise 16 | 17 | app-class: context [ 18 | ;-- private words 19 | __name: __ctx: __id: __file: __last-ts: none 20 | 21 | ;-- public API 22 | timer?: no 23 | rsp-session: on-connect: on-message: on-disconnect: on-timer: clients: none 24 | 25 | set-timer: func [delay [time! none!]][ 26 | either delay [ 27 | scheduler/add-job/every/name compose [fire-event (__ctx) 'on-timer] delay __id 28 | ][ 29 | scheduler/delete __id 30 | ] 31 | timer?: to logic! delay 32 | ] 33 | 34 | send: func [port [port!] data [string!]][ 35 | service/ws-send-response/direct/with data port 36 | ] 37 | 38 | disconnect: func [/with port [port!]][ 39 | either with [ 40 | service/close-client/with port 41 | ][ 42 | service/close-client 43 | ] 44 | ] 45 | 46 | do-task: func [data [string!] /on-done handler [function! block!]][ ;-- handler: func [client data][...] 47 | __ctx/in/content: data 48 | if on-done [append/only __ctx/tasks :handler] ;-- store handler for deferred action 49 | service/mod-list/mod-rsp/make-response __ctx ;-- trigger a bg job through RSP pipe 50 | __ctx: none 51 | ] 52 | ] 53 | 54 | make-unique-id: has [id][ 55 | until [ 56 | id: random 9999 57 | either empty? apps [true][ 58 | foreach [name app] apps [if app/__id = id [break/return false] true] 59 | ] 60 | ] 61 | to word! join "SA" id 62 | ] 63 | 64 | set 'install-socket-app func [spec [block!] /local new][ 65 | new: make make app-class [__id: make-unique-id clients: make hash! 100] spec 66 | repend apps [new/name new] 67 | new 68 | ] 69 | 70 | get-app: func [req /local app ts file][ 71 | if all [ 72 | app: select mappings req/in/url 73 | app/__last-ts <> ts: modified? file: app/__file 74 | ][ 75 | app: do file 76 | app/__last-ts: ts 77 | app/__file: file 78 | change next find mappings req/in/url app 79 | remove/part find apps app/__name 2 ;-- remove the old app version 80 | if verbose > 0 [log/info ["socket-app " mold app/__name " updated"]] 81 | ] 82 | app 83 | ] 84 | 85 | fire-event: func [ 86 | req 87 | action [word! function! block!] 88 | /arg data 89 | /local err app current 90 | ][ 91 | app: req/socket-app 92 | app/__ctx: req 93 | app/rsp-session: req/session 94 | current: service/client 95 | service/client: req/socket-port 96 | if error? set/any 'err try pick [ 97 | [app/:action req/socket-port data] ;-- event action 98 | [do :action req/socket-port data] ;-- function! or block! action 99 | ] word? :action [ 100 | log/error rejoin [mold :action " call failed with error: " mold disarm err] 101 | ] 102 | service/client: current 103 | app/__ctx: app/rsp-session: none 104 | ] 105 | 106 | socket-connect: func [req][ 107 | if req/socket-app: get-app req [ 108 | append req/socket-app/clients service/client 109 | req/session: service/mod-list/mod-rsp/sessions/exists? req 110 | req/tasks: make block! 10 111 | fire-event req 'on-connect 112 | ] 113 | true 114 | ] 115 | 116 | socket-message: func [req][ 117 | fire-event/arg req 'on-message as-string req/in/content 118 | true 119 | ] 120 | 121 | socket-disconnect: func [req /local app][ 122 | remove find req/socket-app/clients req/socket-port 123 | fire-event req 'on-disconnect 124 | true 125 | ] 126 | 127 | on-task-done: func [req /local action][ ;-- event generated from mod-rsp 128 | if verbose > 0 [log/info "calling on-task-done"] 129 | if action: pick req/tasks 1 [ 130 | remove req/tasks 131 | fire-event/arg req :action req/out/content 132 | ] 133 | ] 134 | 135 | words: [ 136 | ;--- Define the URL to web socket application name mapping 137 | socket-app: [string!] [word!] in main do [ 138 | use [root file app][ 139 | either root: select scope 'root-dir [ 140 | either exists? file: rejoin [root %/ws-apps/ args/2 ".r"][ 141 | app: do file 142 | app/__file: file 143 | app/__last-ts: modified? file 144 | repend mappings [args/1 app] 145 | ][ 146 | log/error ["can't access file " file] 147 | ] 148 | ][ 149 | log/error ["root-dir is missing, can't load socket-app " mold args/2] 150 | ] 151 | ] 152 | ] 153 | ] 154 | ] 155 | -------------------------------------------------------------------------------- /Cheyenne/mods/mod-ssi.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-ssi 5 | 6 | order: [ 7 | set-mime-type normal 8 | access-check normal 9 | make-response normal 10 | logging last 11 | ] 12 | 13 | cache: context [ 14 | list: make block! 20 15 | max-size: 2000 * 1024 16 | size: 0 17 | 18 | words: [] 19 | 20 | error: ["

Error in SSI : " msg "

"] 21 | 22 | s-mark: {} 24 | out: start: txt: inc: msg: none 25 | 26 | rules: [ 27 | (out: make block! 10) 28 | any [ 29 | start: copy txt to s-mark (if txt [insert tail out txt]) 30 | s-mark 31 | copy type to #"=" (inc: reduce [type]) 32 | 2 skip ; =" 33 | copy value to e-mark ( 34 | insert/only tail out reduce [to-word trim type value] 35 | ) 36 | e-mark 37 | ] 38 | copy txt to end (if txt [insert tail out txt]) 39 | ] 40 | 41 | merge: func [pos /local out path item file ctx s e][ 42 | out: any [ 43 | all [not pos/3 clear pos/3] 44 | make string! 64 * 1024 45 | ] 46 | poke pos 3 out 47 | root: first split-path first pos 48 | foreach item pick pos 4 [ 49 | either block? item [ 50 | do select [ 51 | virtual [ 52 | either exists? file: join root second item [ 53 | insert tail out read/binary file 54 | ][ 55 | msg: rejoin [file " not found"] 56 | return rejoin error 57 | ] 58 | ;ctx: service/process-sub-request second item 59 | ;if s: ctx/out/content [ 60 | ; parse/all s [ 61 | ; [to "" s: 63 | ; [to " pick pos 2 95 | ][ 96 | parse/all read/binary file rules 97 | either pos [ 98 | poke pos 2 now ; -- update 99 | poke pos 4 out 100 | ][ 101 | pos: tail list ; -- add 102 | repend list [file now none out] 103 | ] 104 | ] 105 | merge pos 106 | ] 107 | ] 108 | 109 | declined?: func [req]['SSI <> select service/handlers req/in/ext] 110 | 111 | set-mime-type: func [req][ 112 | if declined? req [return none] 113 | req/out/mime: 'text/html 114 | true 115 | ] 116 | 117 | access-check: func [req /local info mdate][ 118 | ; --- This phase is redefined to avoid Last-Modified header generation 119 | if declined? req [return none] 120 | ; --- Test if the file can be read 121 | unless req/file-info: info? req/in/file [ 122 | req/out/code: 400 123 | ] 124 | true 125 | ] 126 | 127 | make-response: func [req][ 128 | if declined? req [return none] 129 | req/out/code: 200 130 | req/out/content: cache/process req 131 | true 132 | ] 133 | 134 | logging: func [req][ 135 | none 136 | ] 137 | 138 | ] -------------------------------------------------------------------------------- /Cheyenne/mods/mod-upload.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | install-HTTPd-extension [ 4 | name: 'mod-upload 5 | verbose: 0 6 | 7 | order: [ 8 | url-translate first 9 | upload-file first 10 | ] 11 | 12 | uploads: make block! 100 ;-- [id [integer!] req [object!] timestamp [date!]...] 13 | token: none ;-- declared as global to optimize runtime speed 14 | digit: charset "0123465789" 15 | 16 | store: func [token req /local n][ 17 | n: now 18 | remove-each [id req ts] uploads [ts + 00:01 < n] ;-- Remove tokens older than 1 minute 19 | repend uploads [token req n] 20 | ] 21 | 22 | make-upload-id: has [id][ 23 | until [not find uploads id: random 999999999] 24 | id 25 | ] 26 | 27 | url-translate: func [req /local ro ctx current total][ 28 | if parse req/in/url [ 29 | "/upload/" ["status/" copy token 1 9 digit | "get-id" (token: 'new)] 30 | ][ 31 | req/cfg: [] 32 | ro: req/out 33 | ro/code: 200 34 | ro/mime: 'application/json 35 | 36 | either token = 'new [ 37 | ro/content: form make-upload-id 38 | ][ 39 | either ctx: select uploads to integer! token [ 40 | either ctx/tmp [ 41 | current: ctx/tmp/expected - ctx/tmp/remains 42 | total: ctx/tmp/expected 43 | ][ 44 | current: length? any [ctx/in/content ""] 45 | total: any [attempt [to integer! ctx/in/headers/Content-Length] 0] 46 | ] 47 | ro/content: rejoin [ 48 | #"[" 49 | to integer! current / total * 100 #"," 50 | current #"," 51 | total 52 | #"]" 53 | ] 54 | h-store ro/headers 'Cache-Control "no-cache, no-store, max-age=0, must-revalidate" 55 | h-store ro/headers 'Pragma "no-cache" 56 | h-store ro/headers 'Expires "-1" 57 | ][ 58 | ro/code: 404 59 | ro/content: reform ["Error:" token "is not a valid upload token!"] 60 | ro/mime: 'text/plain 61 | ] 62 | ] 63 | return true 64 | ] 65 | none 66 | ] 67 | 68 | upload-file: func [req][ 69 | if parse req/in/url [thru "token=" copy token [1 9 digit] to end][ 70 | store load token req 71 | true 72 | ] 73 | none 74 | ] 75 | 76 | words: [] 77 | ] 78 | -------------------------------------------------------------------------------- /Cheyenne/mods/mod-userdir.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | History: { 3 | 08/09/2010 - Applied Kaj's big patch 4 | 24/09/2010 - Code refactored and simplified 5 | } 6 | ] 7 | 8 | install-HTTPd-extension [ 9 | name: 'mod-userdir 10 | 11 | order: none 12 | user: group: none 13 | col: #":" 14 | 15 | on-started: does [ 16 | if all [user system/version/4 <> 3][ ;-- exclude Windows 17 | set-process-to user any [group user] 18 | ] 19 | ] 20 | on-reloaded: does [ 21 | user: group: none 22 | ] 23 | 24 | try-chown: func [file [file!] uid gid][ 25 | unless zero? chown to-local-file file uid gid [ 26 | log/error ["chown " uid ":" gid " " file " failed!"] 27 | ] 28 | ] 29 | 30 | get-id: func [name [string!] /group /local file rule uid gid][ 31 | set [file rule] pick [ 32 | [%/etc/group []] 33 | [%/etc/passwd [copy uid to col skip]] 34 | ] to-logic group 35 | 36 | unless exists? file [log/error reform ["accessing" file "failed"]] 37 | parse/case/all read file [ 38 | some [name col thru col rule copy gid to col break | thru newline] 39 | ] 40 | unless any [[group gid] all [uid gid]][log/error reform ["id not found in" file]] 41 | reduce [to-integer uid to-integer gid] 42 | ] 43 | 44 | set-process-to: func [user [string! integer!] group [string! integer!] /local uid gid file][ 45 | set [uid gid] reduce [user group] 46 | if any [string? user string? group][ 47 | either user = group [ 48 | set [uid gid] get-id user 49 | ][ 50 | if string? user [uid: first get-id user] 51 | if string? group [gid: second get-id/group group] 52 | ] 53 | ] 54 | if all [not zero? uid not zero? gid][ 55 | ;-- %trace.log 56 | if exists? file: uniserve/services/logger/trace-file [try-chown file uid gid] 57 | 58 | ;-- %.rsp-sessions 59 | if all [ 60 | find service/mod-list 'mod-rsp 61 | exists? file: service/mod-list/mod-rsp/sessions/ctx-file 62 | ][try-chown file uid gid] 63 | 64 | ;-- %.mta-queue 65 | file: uniserve/services/MTA/q-file 66 | if cheyenne/port-id [append copy file join "-" cheyenne/port-id/1] 67 | if exists? file [try-chown file uid gid] 68 | 69 | ;-- %chey-.log 70 | if all [ 71 | file: logger/file.log 72 | exists? file 73 | ][try-chown file uid gid] 74 | ] 75 | ;-- change group id first to inherit privileges from group first 76 | if any [zero? gid not set-gid gid][log/error ["setgid '" group " failed!"]] 77 | if any [zero? uid not set-uid uid][log/error ["setuid '" user " failed!"]] 78 | ] 79 | 80 | words: [ 81 | user: [string! | integer!] in globals do [user: args/1] 82 | group: [string! | integer!] in globals do [group: args/1] 83 | ] 84 | ] -------------------------------------------------------------------------------- /Cheyenne/service/service.c: -------------------------------------------------------------------------------- 1 | #include "service.h" 2 | 3 | void SendQuitMsg(void) 4 | { 5 | WORD version; 6 | WSADATA wsaData; 7 | SOCKET server; 8 | struct sockaddr_in dst; 9 | int err; 10 | 11 | version = MAKEWORD( 1, 1 ); 12 | err = WSAStartup(version, &wsaData); 13 | if (err != 0) return; 14 | 15 | server = socket(AF_INET ,SOCK_DGRAM, IPPROTO_UDP); 16 | if (server == INVALID_SOCKET) return; 17 | 18 | dst.sin_family = AF_INET; 19 | dst.sin_addr.s_addr = inet_addr("127.0.0.1"); 20 | dst.sin_port = htons(10000); 21 | 22 | sendto(server, "Q", 1, 0, (SOCKADDR *)&dst, sizeof(dst)); 23 | 24 | closesocket(server); 25 | WSACleanup(); 26 | } 27 | 28 | BOOL APIENTRY DllMain(HANDLE hModule, DWORD reason, LPVOID lpReserved) 29 | { 30 | return TRUE; 31 | } 32 | 33 | void WINAPI ServiceCtrlHandler(DWORD Opcode) 34 | { 35 | if (Opcode == SERVICE_CONTROL_STOP) { 36 | SvcStatus.dwWin32ExitCode = 0; 37 | SvcStatus.dwCurrentState = SERVICE_STOPPED; 38 | SvcStatus.dwCheckPoint = 0; 39 | SvcStatus.dwWaitHint = 0; 40 | } 41 | SetServiceStatus(SvcStatusHandle, &SvcStatus); 42 | return; 43 | } 44 | 45 | void WINAPI ServiceStart(DWORD argc, LPTSTR *argv) 46 | { 47 | SvcStatus.dwServiceType = SERVICE_WIN32; 48 | SvcStatus.dwCurrentState = SERVICE_RUNNING; 49 | SvcStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP; 50 | SvcStatus.dwWin32ExitCode = 0; 51 | SvcStatus.dwServiceSpecificExitCode = 0; 52 | SvcStatus.dwCheckPoint = 0; 53 | SvcStatus.dwWaitHint = 0; 54 | 55 | SvcStatusHandle = RegisterServiceCtrlHandler(APPNAME, ServiceCtrlHandler); 56 | SetServiceStatus(SvcStatusHandle, &SvcStatus); 57 | return; 58 | } 59 | 60 | void ServiceInit(void) 61 | { 62 | StartServiceCtrlDispatcher(DispatchTable); // blocking call 63 | SendQuitMsg(); 64 | } 65 | 66 | 67 | __declspec(dllexport) void ServiceLaunch(void) 68 | { 69 | _beginthread((void *)ServiceInit, 0, NULL); 70 | } 71 | -------------------------------------------------------------------------------- /Cheyenne/service/service.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | 4 | #define WIN32_LEAN_AND_MEAN 5 | #include 6 | #include 7 | #include 8 | 9 | #define APPNAME "Cheyenne" 10 | 11 | SERVICE_STATUS SvcStatus; 12 | SERVICE_STATUS_HANDLE SvcStatusHandle; 13 | 14 | void WINAPI ServiceStart(DWORD argc, LPTSTR *argv); 15 | void WINAPI ServiceCtrlHandler(DWORD opcode); 16 | 17 | SERVICE_TABLE_ENTRY DispatchTable[] = 18 | { 19 | {APPNAME, ServiceStart}, 20 | {NULL, NULL} 21 | }; 22 | 23 | -------------------------------------------------------------------------------- /Cheyenne/service/service.sln: -------------------------------------------------------------------------------- 1 | Microsoft Visual Studio Solution File, Format Version 8.00 2 | Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "service", "service.vcproj", "{E6D1410B-1790-4CC7-B7D5-823612214726}" 3 | ProjectSection(ProjectDependencies) = postProject 4 | EndProjectSection 5 | EndProject 6 | Global 7 | GlobalSection(SolutionConfiguration) = preSolution 8 | Debug = Debug 9 | Release = Release 10 | EndGlobalSection 11 | GlobalSection(ProjectConfiguration) = postSolution 12 | {E6D1410B-1790-4CC7-B7D5-823612214726}.Debug.ActiveCfg = Debug|Win32 13 | {E6D1410B-1790-4CC7-B7D5-823612214726}.Debug.Build.0 = Debug|Win32 14 | {E6D1410B-1790-4CC7-B7D5-823612214726}.Release.ActiveCfg = Release|Win32 15 | {E6D1410B-1790-4CC7-B7D5-823612214726}.Release.Build.0 = Release|Win32 16 | EndGlobalSection 17 | GlobalSection(ExtensibilityGlobals) = postSolution 18 | EndGlobalSection 19 | GlobalSection(ExtensibilityAddIns) = postSolution 20 | EndGlobalSection 21 | EndGlobal 22 | -------------------------------------------------------------------------------- /Cheyenne/service/service.vcproj: -------------------------------------------------------------------------------- 1 | 2 | 9 | 10 | 12 | 13 | 14 | 20 | 31 | 33 | 45 | 47 | 49 | 51 | 53 | 55 | 57 | 59 | 61 | 63 | 65 | 66 | 72 | 90 | 92 | 106 | 108 | 110 | 112 | 114 | 116 | 118 | 120 | 122 | 124 | 126 | 127 | 128 | 129 | 130 | 131 | 135 | 137 | 138 | 139 | 143 | 145 | 146 | 147 | 151 | 152 | 153 | 154 | 155 | 156 | -------------------------------------------------------------------------------- /Cheyenne/tests/catalogs/en/en.cat: -------------------------------------------------------------------------------- 1 | "Hello" 2 | "we are in" 3 | "January" 4 | "February" 5 | "March" 6 | "April" 7 | "May" 8 | "June" 9 | "July" 10 | "August" 11 | "September" 12 | "October" 13 | "November" 14 | "December" 15 | -------------------------------------------------------------------------------- /Cheyenne/tests/catalogs/fr/fr.cat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/catalogs/fr/fr.cat -------------------------------------------------------------------------------- /Cheyenne/tests/changelog.txt: -------------------------------------------------------------------------------- 1 | versioning here is related to the version of the test framework, not cheyenne's version number. 2 | 3 | v0.6.1 - 22/04/2011 4 | o Added new tests: HTTP-VERSION, STATUS, 5 | 6 | o Error proofed 'IS-HTTP-DATE? test 7 | 8 | o Re-organized tests so they are grouped in separate files, under %test-groups/ 9 | 10 | o cheyenne-http-tests.r, now rebuilt to act as a springboard to launch the various specific test scripts. 11 | 12 | o The system now uses vprint logging in order to store the complete unit test trace. 13 | 14 | o New functions: %mezz.r/get-script-version(), %vprint.r/vlog(), %unit.r/set-default-host() 15 | 16 | o Corrected rebol header datestamps in files... was set in the future! 17 | 18 | o mezz/parse-url can now cope with file paths and doesn't require host or schema parts of the url. 19 | this allows use of the default-port-spec, by only using the part part within the unit test, 20 | and using the host info from the default. 21 | 22 | o improved overall unit engine setup so we can easily do tests over and over again, while only giving a new path or url. 23 | makes HEAD/GET & Host header path testing much easier. 24 | 25 | o Added label parameter for unit testing stubs. This allows reports to store *intent* of each test. 26 | 27 | o Completely rebuilt tracing of tests (console and logs), added stats at the end, and failed tests are now extremely obvious. 28 | 29 | o GET currently has 7 tests 30 | 31 | o HEAD currently has 1 test 32 | 33 | o HEADERS-Accept-language currently has 3 tests. 34 | 35 | o Removed files from SVN: 36 | unit-engine-testing.r - Its now pointless, the engine works well enough. 37 | implementation.txt - File has been replaced by this changelog.txt file, which is always up to date. 38 | 39 | 40 | v0.6.0 - 21/04/2011 41 | 42 | o Connection errors are now trapped and added to unit/test-report. 43 | 44 | o Added http-url() and tcp-url() within !unit class. 45 | 46 | o Added Assert() within !unit class. 47 | 48 | o Setup a www site for unit testing. 49 | 50 | o Added SAME-HEADER? test 51 | 52 | o Added RESPONSE-TIME test 53 | 54 | o !unit/Build-http-header now adds the fields to the actual request/header object as well as request/header-buffer 55 | 56 | o added request/user-header. Accessible via http-test/WITH . 57 | 58 | o added automated support for form post data, using new request/params. 59 | 60 | -------------------------------------------------------------------------------- /Cheyenne/tests/cheyenne-http-tests.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/cheyenne-http-tests.r -------------------------------------------------------------------------------- /Cheyenne/tests/cheyenne-supported-http-return-codes.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 10.1 Informational 1xx 4 | ----- 5 | [ ] 100 Continue 10.1.1 6 | [x] 101 Switching Protocols 10.1.2 ; supported for websockets only 7 | 8 | 9 | 10.2 Successful 2xx 10 | ----- 11 | [x] 200 OK 10.2.1 12 | [ ] 201 Created 10.2.2 13 | [ ] 202 Accepted 10.2.3 14 | [ ] 203 Non-Authoritative Information 10.2.4 15 | [x] 204 No Content 10.2.5 16 | [ ] 205 Reset Content 10.2.6 17 | [ ] 206 Partial Content 10.2.7 18 | 19 | 20 | 10.3 Redirection 3xx 21 | ----- 22 | [ ] 300 Multiple Choices 10.3.1 23 | [x] 301 Moved Permanently 10.3.2 24 | [x] 302 Found 10.3.3 25 | [ ] 303 See Other 10.3.4 26 | [x] 304 Not Modified 10.3.5 27 | [ ] 305 Use Proxy 10.3.6 28 | [ ] 307 Temporary Redirect 10.3.8 29 | 30 | 31 | 10.4 Client Error 4xx 32 | ----- 33 | [ ] 400 Bad Request 10.4.1 34 | [ ] 401 Unauthorized 10.4.2 35 | [ ] 402 Payment Required 10.4.3 36 | [ ] 403 Forbidden 10.4.4 37 | [x] 404 Not Found 10.4.5 38 | [x] 405 Method Not Allowed 10.4.6 39 | [ ] 406 Not Acceptable 10.4.7 40 | [ ] 407 Proxy Authentication Required 10.4.8 41 | [ ] 408 Request Timeout 10.4.9 42 | [ ] 409 Conflict 10.4.10 43 | [ ] 410 Gone 10.4.11 44 | [ ] 411 Length Required 10.4.12 45 | [ ] 412 Precondition Failed 10.4.13 46 | [ ] 413 Request Entity Too Large 10.4.14 47 | [ ] 414 Request-URI Too Long 10.4.15 48 | [ ] 415 Unsupported Media Type 10.4.16 49 | [ ] 416 Requested Range Not Satisfiable 10.4.17 50 | [ ] 417 Expectation Failed 10.4.18 51 | 52 | 53 | 10.5 Server Error 5xx 54 | ----- 55 | [x] 500 Internal Server Error 10.5.1 56 | [ ] 501 Not Implemented 10.5.2 57 | [ ] 502 Bad Gateway 10.5.3 58 | [ ] 503 Service Unavailable 10.5.4 59 | [ ] 504 Gateway Timeout 10.5.5 60 | [ ] 505 HTTP Version Not Supported 10.5.6 61 | -------------------------------------------------------------------------------- /Cheyenne/tests/libs/classes.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/libs/classes.r -------------------------------------------------------------------------------- /Cheyenne/tests/libs/mezz.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/libs/mezz.r -------------------------------------------------------------------------------- /Cheyenne/tests/libs/tests.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/libs/tests.r -------------------------------------------------------------------------------- /Cheyenne/tests/libs/unit.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/libs/unit.r -------------------------------------------------------------------------------- /Cheyenne/tests/requirements.txt: -------------------------------------------------------------------------------- 1 | Cheyenne's Units Tests requirements 2 | 3 | Nenad Rakocevic 4 | start date: 21/11/2009 5 | 6 | 7 | ===Goals and needs 8 | 9 | The goal is to build a test suite for regression testing. So, the tests should cover only features supported by Cheyenne (not all RFC features). 10 | 11 | 12 | * short & simple testing engine 13 | * simple tests description structure 14 | * named groups of tests (with ability to make group of groups) 15 | * ability to run tests for one given group only 16 | * one file = one group of tests (if it makes things simplier only) 17 | * all test files should be in the same folder 18 | 19 | ---Testing engine 20 | 21 | I see 2 options : 22 | 23 | * use an existing unit test engine written in REBOL. 24 | * write one that will be adequate for the job. 25 | 26 | The second one has my preference but only if it doesn't take more than 2-3 days to build. Ideally, it should be built incrementally as testing support needs grow. 27 | 28 | The engine should define some local functions dedicated to HTTP requests sending and analyzing. 29 | 30 | Exemple : 31 | 32 | define-tests [ ;-- 'define-tests will load this test group in engine 33 | ;-- tests definition is a custom simple dialect 34 | 35 | group "HTTP low-level tests" ;-- group naming 36 | 37 | "GET method" [ ;-- string! for test name, block! for test specs 38 | ;-- spec block should accept REBOL code 39 | res: send server [ 40 | method: "GET" 41 | URL: "basic.html" 42 | version: 1.0 ;-- HTTP protocol version 43 | keep-alive: no ;-- close the connection once response retrieved 44 | ] ;-- keep-alive: yes will be required to test persistent 45 | ;-- connections. 46 | 47 | check res/code 200 ;-- 'check: func [value1 value2] : compare values 48 | ;-- and if == then test's OK, else test KO. 49 | 50 | check ;-- check can be called several times in the same test 51 | res/content/length ;-- 'req is an object! storing pre-parsed response. 52 | res/headers/Content-length 53 | 54 | check 55 | 123456789 56 | checksum res/content/data 57 | ] 58 | ... 59 | 60 | Possible output in console : 61 | 62 | Group: HTTP low-level tests 63 | #1 : GET method => passed OK 64 | or 65 | #1 : GET method => *** Error on check #2 66 | 67 | 68 | 69 | 70 | ===HTTP protocol (priority 1) 71 | 72 | Tests should be written using latest HTTP RFC (should be 2616) and other related RFCs as reference documentation. 73 | 74 | * request line parsing 75 | * client headers parsing and semantics 76 | * server headers correctness 77 | * adequate response codes 78 | * correct HTTP1.0 answers (when client asks for 1.0) 79 | * correct HTTP1.1 specific features support (like pipelining) 80 | 81 | ===Cheyenne (priority 2) 82 | 83 | The following tests also include testing configuration keywords declared in each mod. 84 | 85 | * mod-static specific features testing 86 | * mod-ssi specific features testing 87 | * mod-fastcgi & mod-extapp specific features testing (using PHP as backend) 88 | * OS specific tests (low priority ~3) 89 | 90 | Others mods will be implicitly tested in other groups of tests. 91 | 92 | ===RSP (priority 2) 93 | 94 | * POST data handling (with cheyenne's specific features tests) 95 | * GET & POST data decoding (including multipart encoding) 96 | * RSP API complete cover (http://cheyenne-server.org/docs/rsp-api.html) 97 | * Webapp's events 98 | * Webapps isolation 99 | * Sessions life cycle 100 | 101 | ===CGI (priority 3) 102 | 103 | * REBOL CGI's compliant interface (simulation of REBOL -cgi startup mode) 104 | * General CGI compliance (using simple Perl CGI scripts from Perl's units tests) 105 | 106 | 107 | ===Notes 108 | 109 | ---HTTP testing requirements 110 | 111 | labels for status of individual tests groups. 112 | [x] TO DO / Complete / Confirm 113 | [o] DONE! 114 | [|] In progress (there are already some tests which deal with this.) 115 | [.] Ready to start (framework is known to have some specific support to test this, it now needs actual tests to be added.) 116 | 117 | 118 | 119 | [ ] "OPTIONS" ; Section 9.2 120 | [|] "GET" ; Section 9.3 121 | [|] "HEAD" ; Section 9.4 122 | [.] "POST" ; Section 9.5 123 | [ ] "PUT" ; Section 9.6 124 | [ ] "DELETE" ; Section 9.7 125 | [ ] "TRACE" ; Section 9.8 126 | [ ] "CONNECT" ; Section 9.9 127 | 128 | 129 | GENERAL REQUEST FIELDS (request and response) 130 | ---- 131 | [ ] Cache-Control ; Section 14.9 132 | [x] Connection ; Section 14.10 ; supported: close, keep-alive 133 | [|] Date ; Section 14.18 134 | [ ] Pragma ; Section 14.32 135 | [ ] Trailer ; Section 14.40 136 | [x] Transfer-Encoding ; Section 14.41 ; chunk-encoding only in response 137 | [x] Upgrade ; Section 14.42 ; supported for web-sockets only 138 | [ ] Via ; Section 14.45 139 | [ ] Warning ; Section 14.46 140 | 141 | REQUEST FIELDS 142 | ---- 143 | [ ] Accept ; Section 14.1 144 | [ ] Accept-Charset ; Section 14.2 145 | [ ] Accept-Encoding ; Section 14.3 146 | [|] Accept-Language ; Section 14.4 147 | [ ] Authorization ; Section 14.8 148 | [ ] Expect ; Section 14.20 149 | [ ] From ; Section 14.22 150 | [.] Host ; Section 14.23 151 | [ ] If-Match ; Section 14.24 152 | [.] If-Modified-Since ; Section 14.25 153 | [ ] If-None-Match ; Section 14.26 154 | [ ] If-Range ; Section 14.27 155 | [ ] If-Unmodified-Since ; Section 14.28 156 | [ ] Max-Forwards ; Section 14.31 157 | [ ] Proxy-Authorization ; Section 14.34 158 | [ ] Range ; Section 14.35 159 | [ ] Referer ; Section 14.36 160 | [ ] TE ; Section 14.39 161 | [ ] User-Agent ; Section 14.43 162 | 163 | RESPONSE FIELDS ; any valid response header can be returned by a RSP script 164 | ---- 165 | [ ] Accept-Ranges ; Section 14.5 166 | [ ] Age ; Section 14.6 167 | [ ] ETag ; Section 14.19 168 | [x] Location ; Section 14.30 169 | [ ] Proxy-Authenticate ; Section 14.33 170 | [ ] Retry-After ; Section 14.37 171 | [x] Server ; Section 14.38 172 | [ ] Vary ; Section 14.44 173 | [ ] WWW-Authenticate ; Section 14.47 174 | 175 | 176 | ENTITY FIELDS 177 | ---- 178 | [ ] Allow ; Section 14.7 179 | [x] Content-Encoding ; Section 14.11 180 | [ ] Content-Language ; Section 14.12 181 | [|] Content-Length ; Section 14.13 182 | [ ] Content-Location ; Section 14.14 183 | [ ] Content-MD5 ; Section 14.15 184 | [ ] Content-Range ; Section 14.16 185 | [|] Content-Type ; Section 14.17 186 | [x] Expires ; Section 14.21 187 | [x] Last-Modified ; Section 14.29 -------------------------------------------------------------------------------- /Cheyenne/tests/test-groups/GET.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/test-groups/GET.r -------------------------------------------------------------------------------- /Cheyenne/tests/test-groups/HEAD.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/test-groups/HEAD.r -------------------------------------------------------------------------------- /Cheyenne/tests/test-groups/HEADERS_Accept-Langage.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/tests/test-groups/HEADERS_Accept-Langage.r -------------------------------------------------------------------------------- /Cheyenne/tests/www/200bytes.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 6 | 7 | -------------------------------------------------------------------------------- /Cheyenne/tests/www/200bytes.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 6 | 7 | -------------------------------------------------------------------------------- /Cheyenne/tests/www/lang.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | ;-------------------------------------------------------- 3 | ; THIS FILE IS BUILT TO PROOF THE HANDLING OF LOCALE 4 | ; via support for the Accept-Language header field 5 | ;-------------------------------------------------------- 6 | prin say "Hello" 7 | %> -------------------------------------------------------------------------------- /Cheyenne/tests/www/subdir/200bytes.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 6 | 7 | -------------------------------------------------------------------------------- /Cheyenne/tests/www/subdir/200bytes.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 6 | 7 | -------------------------------------------------------------------------------- /Cheyenne/tests/www/subdir/lang.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | ;-------------------------------------------------------- 3 | ; THIS FILE IS BUILT TO PROOF THE HANDLING OF LOCALE 4 | ; via support for the Accept-Language header field 5 | ;-------------------------------------------------------- 6 | prin say "Hello" 7 | %> -------------------------------------------------------------------------------- /Cheyenne/www/chat.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 52 | 53 | 146 | 147 | 148 |

Realtime chat demo using websockets

149 | - requires a websocket hybi-10 enabled browser like Chrome 14, FF 8 or IE 10 - 150 |

151 |
Connection state : connecting...
152 | 153 |
154 | User name 155 | 156 | 157 |
158 | 159 | 160 | 161 | 168 | 169 | 174 |
162 |
163 |
    164 |
    165 |     		166 |
    167 |
    170 | 171 | 172 | 173 |
    175 | 176 |
    177 | This demo is powered by the Cheyenne Web Server using the latest revision from our 178 | SVN repository. 179 |
    180 | You can find the server-side source code of this demo here. 181 |

    182 | More informations and contact info in Cheyenne's blog. 183 |
    184 | 185 | -------------------------------------------------------------------------------- /Cheyenne/www/custom404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Custom 404 4 | 5 | 6 | 7 |
    8 |

    This is an example of a customized 404 error page.

    9 | 10 | Go back to home page

    11 |
    12 | 13 | -------------------------------------------------------------------------------- /Cheyenne/www/email.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | ;================= Email API quick syntax ================== 3 | ; id: send-email [ 4 | ; (*) from: email! | ["name" email!] 5 | ; (*) to: email! | ["name" email!] | [email! | ["name" email!]...] 6 | ; cc: email! | ["name" email!] | [email! | ["name" email!]...] 7 | ; bcc: email! | ["name" email!] | [email! | ["name" email!]...] 8 | ; (*) subject: 9 | ; ...any other header 10 | ; 11 | ; -- pseudo headers 12 | ; attach: %file | [%file] | [%file [%filename data]...] 13 | ; charset: "ISO-8859-1" 14 | ; report: [ 15 | ; to: email! | ["name" email!] ; if target different from emitter 16 | ; from: email! | ["name" email!] ; customize emitter 17 | ; subject: string! ; if not defined a default one will be provided 18 | ; body: string! | word! ; custom message with tags ($TARGET$,$ERROR$) 19 | ; ] 20 | ; ] body 21 | ; 22 | ; (*): mandatory headers 23 | ; 24 | ; email-info? id 25 | ; == [ 26 | ; done | pending 27 | ; 2x3 ; 2 emails on 3 sent (can be used to display a progress bar) 28 | ; ok | error [email1 "message1" email2 "message2"...] 29 | ; ] 30 | ;============================================================ 31 | 32 | invalid: validate/full [ 33 | id integer! - 34 | from email! * 35 | to - * 36 | subject - * 37 | msg - * 38 | file - - 39 | ] 40 | param: request/content 41 | 42 | ;-- check attach file and format it for send-email 43 | ten-mega: 10 * (2 ** 20) 44 | if block? file: param/file [ 45 | file/1: to-file file/1 46 | 47 | param/file: either zero? sz: size? file/2 [ 48 | none 49 | ][ 50 | if ten-mega < sz [ 51 | print "Attached file not found or size above 10MB limit!" 52 | response/end 53 | ] 54 | file/2: read/binary file/2 55 | reduce [param/file] 56 | ] 57 | ] 58 | if not invalid [ 59 | param/id: send-email [ 60 | from: param/from 61 | to: param/to 62 | subject: param/subject 63 | attach: param/file 64 | ] param/msg 65 | ] 66 | %> 67 | 68 | Email Form 69 | 70 | <%either param/id [%> 71 |
    ...sending progress: <%=mold res: email-info? param/id%>
    72 | <%either all [res res/1 = 'pending][%> 73 | 74 | <%][%> 75 |
    76 | Ok, email(s) sent! 77 |

    78 | Click here to post a new one. 79 | <%] 80 | ][%> 81 |

    Email sending demo

    82 |
    83 | 84 | 85 | 86 | 89 | 90 | 91 | 94 | 95 | 96 | 99 | 100 | 101 | 104 | 105 | 106 | 109 | 110 | 111 | 114 | 115 |
    From 87 | 88 |
    To 92 | 93 |
    Subject 97 | 98 |
    Message 102 | 103 |
    Attached 107 | 108 |
      112 | 113 |
    116 |
    117 | <%]%> 118 | 119 | 120 | 121 | 122 | 123 | -------------------------------------------------------------------------------- /Cheyenne/www/flush.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | res: t0: none 3 | servers: [ 4 | http://www.rebol.com 5 | http://www.altme.com 6 | http://softinnov.org 7 | http://cheyenne-server.org 8 | ] 9 | 10 | ;--- Hack to make Chrome start rendering partial content -- 11 | print head insert/dup copy "" " " 2000 12 | response/flush 13 | ;--- 14 | 15 | system/schemes/HTTP/timeout: 5 16 | foreach server servers [ 17 | t0: now/time/precise 18 | res: attempt [exists? server] 19 | print [ 20 | server 21 | now/time/precise - t0 22 | pick ["OK" "KO"] to-logic res 23 |

    24 | ] 25 | response/flush 26 | ] 27 | print "end" 28 | ;-- the RSP engine flushes the remaining buffer automatically 29 | %> -------------------------------------------------------------------------------- /Cheyenne/www/form-email.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | set-net [dockimbel@free.fr smtp.free.fr none none none none] 3 | 4 | msg: make string! 1024 5 | foreach [name value] request/content [ 6 | repend msg [name ": " value] 7 | ] 8 | send/header test@softinnov.com msg make system/standard/email [ 9 | From: test@test.com 10 | Subject: "Test" 11 | ] 12 | 13 | ;response/redirect "http://softinnov.org" 14 | %> -------------------------------------------------------------------------------- /Cheyenne/www/inc.rsp: -------------------------------------------------------------------------------- 1 | <% help op! %> 2 |

    3 | <% include %show.rsp %> -------------------------------------------------------------------------------- /Cheyenne/www/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Welcome! 4 | 5 | 6 | 7 |
    8 |

    Congratulations, you are running Cheyenne!

    9 | 10 | Test CGI script

    11 | Test RSP script

    12 | Test RSP script with chunked output

    13 | Test RSP WebApp

    14 |
    15 | 16 | -------------------------------------------------------------------------------- /Cheyenne/www/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/www/logo.png -------------------------------------------------------------------------------- /Cheyenne/www/manual.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | if val: select request/content 'action [ 3 | any [ 4 | all [ 5 | val = "go" 6 | not session/active? 7 | session/start 8 | response/redirect "/manual.rsp" 9 | ] 10 | all [ 11 | val = "halt" 12 | session/active? 13 | session/end 14 | response/redirect "/manual.rsp" 15 | ] 16 | ] 17 | ] 18 | %> 19 | 20 | 21 | Manual Sessions 22 | 23 | 24 | 25 |
    26 |

    Manual session mode

    27 |

    Your ID is : <%=session/id%>

    28 |
    29 | <%either session/active? [%> 30 | 31 | 32 | <%][%> 33 | 34 | 35 | <%]%> 36 |
    37 | Test RSP script 38 |
    39 | 40 | -------------------------------------------------------------------------------- /Cheyenne/www/perl/env.cgi: -------------------------------------------------------------------------------- 1 | #!C:\Perl\bin\perl.exe -wT 2 | use strict; 3 | use CGI::Carp qw(fatalsToBrowser); 4 | 5 | print "Content-type: text/html\n\n"; 6 | print '', "\n"; 7 | print "Variables d'environnement\n"; 8 | print "

    Variables d'environnement:

    \n"; 9 | print "\n"; 10 | print "", 11 | "\n"; 12 | foreach(keys(%ENV)) { 13 | print "\n"; 14 | } 15 | print "\n"; 17 | print "
    Nom de variableValeur
    $_$ENV{$_}
    au total: ", 16 | scalar keys(%ENV)," variables d'environnement
    \n"; 18 | print "\n"; -------------------------------------------------------------------------------- /Cheyenne/www/perl/post.cgi: -------------------------------------------------------------------------------- 1 | #!C:\Perl\bin\perl.exe -wT 2 | use CGI qw(:standard); 3 | use CGI::Carp qw(warningsToBrowser fatalsToBrowser); 4 | use strict; 5 | 6 | print header; 7 | print start_html("Thank You"); 8 | print h2("Thank You"); 9 | 10 | my %form; 11 | foreach my $p (param()) { 12 | $form{$p} = param($p); 13 | print "$p = $form{$p}
    \n"; 14 | } 15 | print end_html; 16 | -------------------------------------------------------------------------------- /Cheyenne/www/post.html: -------------------------------------------------------------------------------- 1 | Untitled Page

    -------------------------------------------------------------------------------- /Cheyenne/www/show.cgi: -------------------------------------------------------------------------------- 1 | #!c:\dev\sdk\tools\rebol.exe --cgi 2 | 3 | REBOL [ 4 | Title: "show" 5 | File: %show.cgi 6 | ] 7 | 8 | print "Content-type: text/html^/" 9 | print {Back

    } 10 | print ["Script path :" system/script/path "

    "] 11 | print "CGI Object :" 12 | print "
      " 13 | 14 | foreach name next first system/options/cgi [ 15 | either :name = 'other-headers [ 16 | print ["
    • " name ":
        "] 17 | foreach [n v] list: system/options/cgi/:name [ 18 | print ["
      • " n ": " mold select list n "
        • "] 19 | ] 20 | print "
      • " 21 | ][ 22 | print ["
    • " name ": " mold system/options/cgi/:name "
      • "] 23 | ] 24 | ] 25 | print "
    " 26 | 27 | if system/options/cgi/request-method = "POST" [ 28 | vars: make object! decode-cgi as-string input 29 | if not empty? next first vars [ 30 | print " Variables passed :
      " 31 | foreach name next first vars [ 32 | print ["
    • " name ": " mold vars/:name "
      • "] 33 | ] 34 | print "
    " 35 | ] 36 | ] 37 | print "    " 38 | -------------------------------------------------------------------------------- /Cheyenne/www/show.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Purpose: "test RSP handling of plain REBOL scripts" 3 | ] 4 | 5 | emit [ 6 | 7 | 8 | "RSP Test Page" 9 | 10 | 11 | Back

    12 | 13 | "Timestamp: " now 14 |

    15 |

    "Request parameters :"

    16 |
      17 |
    • "HTTP Method: " mold request/method
      • 18 |
    • "HTTP Port: " mold request/server-port
      • 19 |
    • "Client IP address: " mold request/client-ip
      • 20 |
    21 |

    "Request headers :"

    22 |
      23 | ] 24 | foreach [name value] request/headers [ 25 | emit [
    • name ":" html-encode mold value
      • ] 26 | ] 27 | emit [ 28 |
    29 |

    "Request variables :"

    30 |
      31 | ] 32 | either empty? request/content [ 33 | emit "
    • No variable passed
      • " 34 | ][ 35 | foreach [name value] request/content [ 36 | emit [
    • name ":" html-encode mold value
      • ] 37 | ] 38 | ] 39 | emit [ 40 |
    41 |

    "Session :"

    42 | ] 43 | either session/content [ 44 | emit [ 45 |
      46 |
    • "SID: " session/id
      • 47 | ] 48 | either empty? session/content [ 49 | emit "
    • No session variables
      • " 50 | ][ 51 | foreach [name value] session/content [ 52 | emit [
    • name ":" html-encode mold value
      • ] 53 | ] 54 | ] 55 | emit
    56 | ][ 57 | 58 | emit [
    • "No session"
    ] 59 | ] 60 | emit [ 61 |     62 | 63 | 64 | ] 65 | debug/print "show.r script evaluated without errors" -------------------------------------------------------------------------------- /Cheyenne/www/show.rsp: -------------------------------------------------------------------------------- 1 | 2 | 3 | RSP Test Page 4 | 5 | 6 | Back

    7 | 8 | Timestamp: <%?now/date " " now/time%> 9 |

    10 |

    Request parameters :

    11 |
      12 |
    • HTTP Method: <%=mold request/method%>
      • 13 |
    • HTTP Port: <%=mold request/server-port%>
      • 14 |
    • Client IP address: <%=mold request/client-ip%>
      • 15 |
    16 |

    Request headers :

    17 |
      <% 18 | foreach [name value] request/headers [ 19 | print [
    • name ":" html-encode mold value
      • ] 20 | ] 21 | %>
    22 |

    Request variables :

    23 |
      <% 24 | either empty? request/content [ 25 | print "
    • No variable passed
      • " 26 | ][ 27 | foreach [name value] request/content [ 28 | print [
    • name ":" html-encode mold value
      • ] 29 | ] 30 | ] 31 | %>
    32 |

    Session :

    33 | <%either session/content [%> 34 |
      35 |
    • SID: <%=session/id%>
      • <% 36 | either empty? session/content [ 37 | print "
    • No session variables
      • " 38 | ][ 39 | foreach [name value] session/content [ 40 | print [
    • name ":" html-encode mold value
      • ] 41 | ] 42 | ] 43 | %>
    44 | <%][%> 45 |
    • No session
    46 | <%]%> 47 | 48 | 49 |     50 | 51 | -------------------------------------------------------------------------------- /Cheyenne/www/test.php: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/app-init.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Purpose: "RSP environement init code" 3 | ] 4 | comment { 5 | on-application-start: does [ 6 | ;--- add here your library / modules loading 7 | ] 8 | 9 | on-application-end: does [ 10 | ;--- add here your library / modules proper closing 11 | ] 12 | 13 | on-database-init: does [ 14 | ;--- add here instance specific init code 15 | ;--- it's called when first database access is made using DO-SQL 16 | ;--- so typical usage is db-cache init when multiple instances 17 | ;--- of the same webapp are running on the same server. 18 | ] 19 | } 20 | 21 | on-session-start: does [ 22 | ;--- add here your per session init code 23 | ;--- ex: session/add 'foo 0 24 | ;--- that can be latter accessed with : session/content/foo 25 | 26 | session/add 'user "guest" 27 | session/add 'hits 1 28 | ] 29 | 30 | on-session-end: does [ 31 | ;--- add here your per session closing/cleanup code 32 | 33 | ] 34 | 35 | on-page-start: has [][ 36 | set 't0 now/time/precise 37 | ] 38 | 39 | on-page-end: has [pos time][ 40 | if pos: find response/buffer "" [ 41 | time: to-integer 1000 * to-decimal (now/time/precise - t0) 42 | insert pos reform [ 43 | "

    Processed in :" 44 | either zero? time ["< 1"][time] 45 | "ms." 46 | ] 47 | ] 48 | ] -------------------------------------------------------------------------------- /Cheyenne/www/testapp/count.rsp: -------------------------------------------------------------------------------- 1 | 2 | Session counter test 3 | 4 |

    5 | 6 | Page <% print any [all [select request/content 'page] "unknown!"] %> 7 |
      8 |
    • Session ID = <%=session/id%>
      • 9 |
    • Count = <%=session/content/hits%>
      • 10 |
    11 |     12 | <% 13 | session/content/hits: session/content/hits + 1 14 | if session/content/hits = 20 [session/content/hits: 0] 15 | %> 16 | 17 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/four.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/inc.rsp: -------------------------------------------------------------------------------- 1 | <% help op! %> 2 |

    3 | <% include %show.rsp %> -------------------------------------------------------------------------------- /Cheyenne/www/testapp/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Welcome to TestApp web application 4 | 5 | 6 | 7 |
    8 |

    Congratulations, you are running HTTPd service in Uniserve!

    9 | 10 | Example RSP script 11 |
    12 | 13 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/index.rsp: -------------------------------------------------------------------------------- 1 | <% debug/on %> 2 | 3 | 4 | Welcome to TestApp web application 5 | 6 | 7 | 8 |
    9 |

    Welcome!

    10 |

    Your ID is : <%=session/id%>

    11 | Example RSP script

    12 | Test page : 4 RSP concurently

    13 | Test page : 16 RSP concurently

    14 |



    15 | Logout 16 |
    17 | 18 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/login.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | user: "test" 3 | pass: "letmein" 4 | 5 | in-user: select request/content 'login 6 | in-pass: select request/content 'pass 7 | 8 | if all [user = in-user pass = in-pass][ 9 | session/content/login?: yes 10 | response/redirect "index.rsp" 11 | ] 12 | %> 13 | 14 | 15 | Login 16 | 17 | 18 | 19 |
    20 |

    Please login

    21 | (use: test / letmein) 22 |

    23 | <% 24 | if all [in-user in-user <> user][print {Error: Invalid login!}] 25 | if all [in-pass in-pass <> pass][print {
    Error: Invalid password!}] 26 | %> 27 |
    28 | 29 | 30 | 31 | 32 |
    Login
    Pass
     
    33 |
    34 | 35 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/logo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/www/testapp/logo.gif -------------------------------------------------------------------------------- /Cheyenne/www/testapp/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/www/testapp/logo.png -------------------------------------------------------------------------------- /Cheyenne/www/testapp/logout.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | ;session/content/login?: false 3 | session/end 4 | response/redirect "/" 5 | %> -------------------------------------------------------------------------------- /Cheyenne/www/testapp/public/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dockimbel/cheyenne/ecb4da6c515f466273c16aa5eaf49193aaee1875/Cheyenne/www/testapp/public/logo.png -------------------------------------------------------------------------------- /Cheyenne/www/testapp/show.rsp: -------------------------------------------------------------------------------- 1 | 2 | 3 | RSP Test Page 4 | 5 | 6 | Back

    7 | 8 | Timestamp: <%=now%> 9 |

    10 |

    Request parameters :

    11 |
      12 |
    • HTTP Method: <%=mold request/method%>
      • 13 |
    • HTTP Port: <%=mold request/server-port%>
      • 14 |
    • Client IP address: <%=mold request/client-ip%>
      • 15 |
    16 |

    Request headers :

    17 |
      <% 18 | foreach [name value] request/headers [ 19 | print [
    • name ":" mold value
      • ] 20 | ] 21 | %>
    22 |

    Request variables :

    23 |
      <% 24 | either empty? request/content [ 25 | print "
    • No variable passed
      • " 26 | ][ 27 | foreach [name value] request/content [ 28 | print [
    • name ":" mold value
      • ] 29 | ] 30 | ] 31 | %>
    32 |

    Session :

    33 |
      34 |
    • SID: <%=session/id%>
      • <% 35 | either empty? session/content [ 36 | print "
    • No session variables
      • " 37 | ][ 38 | foreach [name value] session/content [ 39 | print [
    • name ":" mold value
      • ] 40 | ] 41 | ] 42 | %>
    43 | 44 |

    45 | Infinite recursif include test (should be detected):

    46 | <% include %inc.rsp %> 47 |     48 | 49 | -------------------------------------------------------------------------------- /Cheyenne/www/testapp/sixteen.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /Cheyenne/www/upload.html: -------------------------------------------------------------------------------- 1 | Upload

    0 %
    0 bytes
    -------------------------------------------------------------------------------- /Cheyenne/www/upload.rsp: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Cheyenne Upload result page 5 | 8 | 9 | 10 |

    Upload Result:

    11 | <% 12 | validate [ 13 | ufile - 14 | keep - 15 | token integer! 16 | ] 17 | req: request/content 18 | %> 19 |
      20 |
    • file name : <%=mold req/ufile/1%>
      • 21 |
    • file size : <%=size? req/ufile/2%> bytes
      • 22 |
    • temporary file name : <%=mold req/ufile/2%>
      • 23 | <%if req/keep [%> 24 |
    • file stored at: 25 | <%either 'name-taken = catch [file: request/store req/ufile][%> 26 | *** Error: a file with same name already exists! 27 | <%][ 28 | probe file 29 | ] 30 | ]%> 31 |
    32 | 33 | -------------------------------------------------------------------------------- /Cheyenne/www/ws-apps/chat.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Web Socket realtime chat demo" 3 | Author: "Nenad Rakocevic/Softinnov" 4 | Date: 01/10/2010 5 | ] 6 | 7 | install-socket-app [ 8 | name: 'chat 9 | 10 | users: make block! 10 ;-- stores [port! string!] pairs 11 | history: make block! 50 12 | 13 | broadcast: func [msg][ 14 | foreach port clients [send port msg] ;-- send same data to all connected users 15 | ] 16 | 17 | on-connect: func [client][ 18 | foreach entry history [send client entry] ;-- send msgs' history to new user 19 | foreach [port user] users [send client user] ;-- send connected users list 20 | ] 21 | 22 | on-message: func [client data][ 23 | ;-- escape all html tags for security concerns 24 | data: copy data 25 | replace/all data "<" "<" 26 | replace/all data ">" ">" 27 | 28 | switch data/1 [ 29 | #"m" [ 30 | insert next data join remold [now/time] " " ;-- insert [hh:mm:ss] time prefix 31 | append history data 32 | if 50 <= length? history [remove history] ;-- keep only 50 msgs in history 33 | ] 34 | #"u" [ 35 | if not find users data [ 36 | repend users [client data] ;-- keep users list updated 37 | ] 38 | ] 39 | ] 40 | broadcast data ;-- broadcast messages to all users 41 | ] 42 | 43 | on-disconnect: func [client /local pos user][ 44 | pos: find users client 45 | user: pos/2 46 | remove/part pos 2 47 | broadcast head change user #"r" ;-- send user quit msg to everyone 48 | ] 49 | ] -------------------------------------------------------------------------------- /Cheyenne/www/ws-apps/ws-test-app.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Web Socket test application" 3 | Author: "Nenad Rakocevic/Softinnov" 4 | Date: 29/12/2009 5 | ] 6 | 7 | ;-- Web socket applications are loaded in Cheyenne/UniServe main process. 8 | ;-- To make a new web socket app, just use the 'install-socket-app handler and 9 | ;-- provide a spec block giving at least an application name and implementing one 10 | ;-- or several of available handlers. As this is running in main process, when 11 | ;-- any handler runs, it will block the server, so, you have to keep your code 12 | ;-- very efficient, it should run in between 1ms and 10ms if you want your Cheyenne 13 | ;-- server be able to scale to hundreds of concurrent clients. That's the cost to 14 | ;-- pay for not having multi-threading...Anyway, you can use the 'do-task function 15 | ;-- to run longer code without blocking. The request will be passed to the initial RSP 16 | ;-- script used to established the socket connection. 17 | ;-- 18 | ;-- In addition, the mapping between the URL and the socket application MUST be defined in 19 | ;-- %httpd.cfg config file in host or webapp sections using 'socket-app keyword : 20 | ;-- 21 | ;-- ex: socket-app "/ws.rsp" ws-test-app 22 | ;-- 23 | 24 | install-socket-app [ ;-- load application at Cheyenne startup 25 | name: 'ws-test-app ;-- mandatory name, filename have to be identical 26 | 27 | ;-- on-connect event happens when a new web socket is open by a remote client. 28 | ;-- the 'client argument is the port! value used to comunicate with the client 29 | ;-- it also uniquely identifies the connection. Client port will be automatically 30 | ;-- added to connection list called 'clients that can be read at any time (read only!). 31 | on-connect: func [client][ 32 | print "client socket connected!" 33 | if not timer? [ ;-- 'timer? returns TRUE is a timer is running else FALSE (read only!) 34 | set-timer 0:0:05 ;-- switch on timer event for this app with a delay of 35 | ] ;-- 5 secs between each one. 36 | ] 37 | 38 | ;-- on-disconnect event happens when a client disconnects or when you use the 'disconnect 39 | ;-- function to force disconnection. The 'client argument is the client port value. Once 40 | ;-- this event processed, the client port is removed from the 'clients list of connections. 41 | on-disconnect: func [client][ 42 | if empty? clients [ ;-- 'clients connection list is a hash!, so all series functions apply. 43 | set-timer none ;-- passing none to 'set-timer will stop the timer. 44 | ] 45 | ] 46 | 47 | ;-- on-message event happens when the server receives a message from the client (can happen only 48 | ;-- while the connection is opened). The client port is passed in 'client argument. The 'data argument 49 | ;-- contains the text message as a string! value from the client in UTF-8 encoding. 50 | on-message: func [client data][ 51 | ;send client data ;-- 'send function emit string! data to client (must be UTF-8 encoded!). 52 | ;-- 'send will emit the data to the client from which the message originates. 53 | do-task/on-done data func [client data][ ;-- 'do-task processes the argument data (string!) in background 54 | data: uppercase data ;-- simulates a post-processing action 55 | print ["post-processing:" data] 56 | send client data 57 | ] 58 | ] ;-- passing the data to the initial RSP script. Currently, the response 59 | ;-- data from the RSP is sent directly to the client. 60 | 61 | ;-- on-timer event happens only if 'set-timer has been used previously with a time! value. 62 | ;-- This event will keep been generated until 'set-timer is called with 'none value. 63 | on-timer: does [ 64 | foreach port clients [ ;-- 'clients series can be traversed 65 | send port "tick" ;-- 'send the data to the given client port 66 | ] 67 | ] 68 | 69 | ;-- RSP session support (should work ok, but untested yet) 70 | ;-- If the socket has been opened from a RSP webapp, the session object is available from within the 71 | ;-- socket application. Usage: 72 | ;-- 73 | ;-- rsp-session/vars ;-- block of name/value pairs (word! anytype!). Reading is always safe. 74 | ;-- ;-- Writing *only* if no background tasks is running. 75 | ;-- 76 | ;-- rsp-session/busy? ;-- returns TRUE is a background task is running else FALSE. Use it 77 | ;-- ;-- to synchronize session variables writings. 78 | ] -------------------------------------------------------------------------------- /Cheyenne/www/ws.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Welcome! 5 | 6 | 7 |
    8 |

    Web Socket test page

    9 | 10 | 26 | 27 | 28 |
    29 | 30 | -------------------------------------------------------------------------------- /Cheyenne/www/ws.rsp: -------------------------------------------------------------------------------- 1 | <% 2 | 3 | ;-- RSP API web sockets specific changes -- 4 | ; 5 | ; request/web-socket? => true if this is an incoming socket message, false if it's HTTP. 6 | ; request/content/data => contains the socket message (string!) 7 | 8 | ;-- only allow web socket clients (protects from direct access with HTTP) 9 | if not request/web-socket? [response/redirect "ws.html"] 10 | 11 | ;-- just echo back the message 12 | prin request/content/data 13 | 14 | %> -------------------------------------------------------------------------------- /Cheyenne/www/ws2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 17 | 18 | 19 |
    20 |
    21 | 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Cheyenne Web Server 2 | ======== 3 | 4 | 5 | Cheyenne is a high-end web and application server for the REBOL programming language. 6 | -------------------------------------------------------------------------------- /UniServe/BSD-License.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009, Nenad Rakocevic / Softinnov 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 5 | 6 | o Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 7 | 8 | o Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 9 | 10 | o Neither the name of Softinnov nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 13 | 14 | -------------------------------------------------------------------------------- /UniServe/change-log.txt: -------------------------------------------------------------------------------- 1 | UniServe ChangeLog: 2 | ------------------ 3 | 4 | 0.9.38 17/01/2010 5 | 6 | o Fixed an issue with 'open-port wrongly querying dns-cache for IP addresses instead 7 | of domain names. 8 | 9 | 10 | 0.9.37 09/10/2009 11 | 12 | o Client ports issuing "host unreacheable" error were not removed from event list 13 | resulting in calling 'on-error handler multiple times instead of just once. Fixed. 14 | 15 | 16 | 0.9.36 20/09/2009 17 | 18 | o Set-verbose function added. Allows setting verbose level for all services 19 | and protocols at the same time. 20 | 21 | 22 | 0.9.35 31/08/2009 23 | 24 | o Integration with scheduler lib event loop 25 | o On-write fired in 'write-peer for client ports 26 | o On-error handler now takes the port as first argument (all protocols/services updated) 27 | 28 | 29 | 0.9.34 12/02/2009 30 | 31 | o IN patching code fixed for Encmdview 2.7.6 32 | 33 | 34 | 0.9.33 12/02/2009 35 | 36 | o On-error events now processed through 'fire-event allow logging 37 | and 'stop-event being honored. 38 | 39 | 40 | 0.9.32 31/12/2008 41 | 42 | o no-delay disabled (issue with Vista) 43 | 44 | 45 | 0.9.31 15/11/2008 46 | 47 | o Fixed a bug in 'reopen-port. 48 | 49 | 50 | 0.9.30 19/07/2008 51 | 52 | o Added global 'reopen-port and 'closed-port? functions. 53 | 54 | 55 | 0.9.29 12/05/2008 56 | 57 | o UNLESS native now replaces all "if not" patterns 58 | 59 | 60 | 0.9.28 10/02/2008 61 | 62 | o Fix for main loop premature exiting (was introduced in previous version). 63 | 64 | 65 | 0.9.27 03/12/2007 66 | 67 | o Globally defined words now 'protect-ed. 68 | o Function 'control can now be called with /shutdown option to close 69 | all running servers. 70 | o Fixed: bug in the patching of IN function (running in source mode). 71 | o Native 'launch not modified anymore (using now 'launch*) 72 | 73 | 74 | 0.9.25 09/06/2007 75 | 76 | o Services startup code refactored. Now it's more flexible. 77 | - boot/no-start option added. 78 | - boot/no-loop option deprecated, use /no-wait. 79 | - control/only option added. 80 | - control/all option removed. 81 | 82 | 83 | 0.9.24 27/05/2007 84 | 85 | o Added 'start-time and 'expire properties to port/locals. 86 | o Expiration system refactored. Fixes a major port leaking issue. 87 | 88 | 89 | 0.9.23 17/05/2007 90 | 91 | o More aggressive port closing. 92 | o Fix for an issue with timeout testing method for expired ports. 93 | o 'no-delay port mode restricted to TCP ports only. 94 | 95 | 96 | 0.9.22 13/05/2007 97 | 98 | o Important issue fixed: file handles were not always released properly. 99 | o Fixed a local word ('data) leaking in global context. 100 | 101 | 102 | 0.9.21 05/02/2007 103 | 104 | o Bug Fix in 'open-port on dns cache querying issue. 105 | 106 | 107 | 0.9.20 09/09/2006 108 | 109 | o Error code processing on port operations refactored. Closing code 501 now 110 | correctly handled on all port operations. 111 | 112 | 113 | 0.9.19 25/08/2006 114 | 115 | o Publically released. 116 | o Added a DNS caching system for dns requests. 117 | o Added 'on-write-chunk event to pre-process part of big files just before 118 | sending it. 119 | 120 | 121 | 0.9.18 06/08/2006 122 | 123 | o Changed 'uniserve-path handling (no more CHANGE-DIR-ed) 124 | o Added 'stop-events user function to be able to exit the main event loop. 125 | o URL parsing now done in an external library. 126 | 127 | 128 | 0.9.17 21/12/2004 129 | 130 | o Added 'on-write-done event. 131 | o 'on-write call in 'write-peer temporaly deactivated. 132 | o bugfix in 'open-port, custom port-id now correctly used. 133 | 134 | 135 | 0.9.16 11/11/2004 136 | 137 | o Added expiration/timeout system to client ports. 138 | o Async 'write mode lifetime extended to fix some issues with 139 | blocking writes. 140 | o Added 'on-start event. It's called just after a service 141 | port is opened. 142 | 143 | 144 | 0.9.15 09/11/2004 145 | 146 | o Changed handling of the (state = -1) case in 'on-write event 147 | 148 | 149 | 0.9.14 02/11/2004 150 | 151 | o Fixed a bug in client port! building (prototype block is now 152 | copied before use for a new port). 153 | 154 | 155 | 0.9.13 01/11/2004 156 | 157 | o Fixed a critical bug in user events handling (event functions 158 | persisted in new connections). 159 | 160 | 161 | 0.9.12 29/10/2004 162 | 163 | o Added a /custom refinement support to 'insert-port. 164 | 165 | 166 | 0.9.11 15/10/2004 167 | 168 | o A 'on-raw-received cannot be generated after a on-received 169 | if there's no more incoming packet (while in in-buffer being 170 | not empty). Fixed. 171 | o Improved UDP service handling and bugfixes. 172 | o Packet writing little improvement. 173 | o More consistent 'async-modes value management 174 | o On-data event splitted in 'on-read and 'on-write 175 | o Several minor bugfixes 176 | 177 | 178 | 0.9.10 11/10/2004 179 | 180 | o Bugfix in 'insert-port (added correct path to 'write-peer) 181 | 182 | 183 | 0.9.9 03/10/2004 "History starts" -------------------------------------------------------------------------------- /UniServe/clients/rconsole.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | do %../uni-engine.r 4 | 5 | install-protocol [ 6 | name: 'RConsole 7 | port-id: 9801 8 | 9 | stop-at: to-string to-char 255 10 | 11 | prompt: has [cmd][ 12 | cmd: trim ask "Server> " 13 | if find ["q" "quit" "exit"] cmd [quit] 14 | write-server append cmd stop-at 15 | ] 16 | 17 | on-received: func [data][ 18 | remove back tail data 19 | if not empty? data [prin to-string data] 20 | prompt 21 | ] 22 | events: [] 23 | ] 24 | 25 | uniserve/boot/no-wait/with [protocols [RConsole]] 26 | open-port rconsole://localhost [] 27 | wait [] 28 | -------------------------------------------------------------------------------- /UniServe/libs/cookies.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | comment { 4 | [none 5 | "com" [ 6 | none 7 | "test" [ 8 | cookies | none 9 | "sub1" [...] 10 | "sub2" [ 11 | cookies | none 12 | "sub3" [...] 13 | ... 14 | ] 15 | ... 16 | ] 17 | ... 18 | ] 19 | ... 20 | ] 21 | 22 | cookies: [ 23 | path1 [name1 [...] name2 [...]] 24 | path2 [...] 25 | ] 26 | 27 | } 28 | 29 | ;do-cache uniserve-path/libs/log.r 30 | do-cache uniserve-path/libs/idate.r 31 | 32 | cookies: make log-class [ 33 | name: 'cookies 34 | verbose: 2 35 | 36 | db: reduce [none] 37 | v: none 38 | 39 | proto: context [ 40 | name: value: expires: path: domain: secure: max-age: version: 41 | comment: sub?: kill-date: none 42 | ] 43 | 44 | count: func [s [series!] value /local n][ 45 | n: 0 46 | parse/all s [any [value (n: n + 1) | skip]] 47 | n 48 | ] 49 | 50 | chars: complement charset ";" 51 | dquote: #"^"" 52 | 53 | copy-rule: [#"=" opt dquote copy v some chars opt dquote [#";" | end]] 54 | 55 | decode: func [data [string!] /local new][ 56 | new: make proto [] 57 | parse data [ 58 | copy v to #"=" (new/name: v) 59 | copy-rule (new/value: v) any [ 60 | "domain" copy-rule (new/domain: v) 61 | | "path" copy-rule (new/path: v) 62 | | "expires" copy-rule (new/expires: v) 63 | | "max-age" copy-rule (new/max-age: v) 64 | | "version" copy-rule (new/version: v) 65 | | "comment" copy-rule (new/comment: v) 66 | | "secure" [to #";" | to end] (new/secure: true) 67 | ] 68 | ] 69 | new 70 | ] 71 | 72 | store: func [ 73 | domain [string!] path [string!] spec [string!] 74 | /local new name pos base value rem? data m-path 75 | ][ 76 | new: decode spec 77 | 78 | ;if all [new/domain lesser? length? domain length? new/domain][return false] 79 | if all [new/path find/any/match new/path join "*" path][path: new/path] 80 | if all [ 81 | new/domain 82 | find/any/match new/domain join "*" domain 83 | 2 <= count new/domain #"." 84 | ][ 85 | if #"." = first domain: new/domain [ 86 | remove domain 87 | new/sub?: yes 88 | ] 89 | ] 90 | 91 | base: db 92 | domain: head reverse parse domain "." 93 | remove-each pos domain [empty? pos] 94 | ;if 2 > length? domain [return false] 95 | 96 | ;-- Find the right place for the cookie, build it if necessary 97 | while [not tail? domain][ 98 | if not pos: select base first domain [ 99 | append base first domain 100 | append/only base pos: reduce [none] 101 | ] 102 | base: next pos 103 | domain: next domain 104 | ] 105 | 106 | ;-- Determine if the cookie has to be removed 107 | rem?: to logic! either all [ 108 | new/max-age 109 | value: attempt [to integer! new/max-age] 110 | zero? value 111 | ][ 112 | yes 113 | ][ 114 | all [ 115 | value: any [ 116 | all [value now + to time! value] 117 | all [new/expires to-rebol-date new/expires] 118 | ] 119 | now > new/kill-date: value + now/zone 120 | ] 121 | ] 122 | data: first base: head base 123 | ;-- If to be removed and not found in DB, exit 124 | if all [rem? none? data][return false] 125 | ;-- Store it or remove it 126 | either rem? [ 127 | if any [ 128 | none? m-path: select data path 129 | none? pos: find m-path new/name 130 | ][return false] 131 | remove/part pos 2 132 | ][ 133 | if none? data [change/only base data: make block! 1] 134 | if none? m-path: select data path [ 135 | insert tail data path 136 | insert/only tail data m-path: make block! 1 137 | ] 138 | either pos: find m-path new/name [ 139 | change next pos new 140 | ][ 141 | insert tail m-path new/name 142 | insert tail m-path new 143 | ] 144 | ] 145 | new 146 | ] 147 | 148 | destroy: func [][ 149 | 150 | ] 151 | 152 | build: func [domain [string!] path [string!] /local base data][ 153 | out: make string! 16 154 | base: db 155 | domain: head reverse parse domain "." 156 | remove-each pos domain [empty? pos] 157 | while [not tail? domain][ 158 | if not pos: select base first domain [return none] 159 | base: next pos 160 | domain: next domain 161 | ] 162 | if not pos: select first base: head base path [return none] 163 | foreach [name obj] pos [ 164 | insert tail out name 165 | insert tail out #"=" 166 | insert tail out obj/value 167 | insert tail out "; " 168 | ] 169 | clear back back tail out 170 | out 171 | ] 172 | 173 | show: has [rule domain cookies out path list value][ ;-- for debugging only 174 | print "---- Cookie DataBase ----" 175 | if empty? db [print "empty" exit] 176 | domain: make block! 1 177 | cookies: [ 178 | ( 179 | out: copy "+ " 180 | foreach p domain [repend out [p #"."]] 181 | remove back tail out 182 | print out 183 | ) 184 | some [ 185 | set path string! set list block! ( 186 | print [tab path] 187 | foreach [name obj] list [ 188 | prin [tab tab name "=" obj/value] 189 | if obj/expires [ 190 | prin ["; expires=" obj/expires #"(" obj/kill-date #")"] 191 | ] 192 | if obj/max-age [ 193 | prin ["; max-age=" obj/max-age #"(" obj/kill-date #")"] 194 | ] 195 | prin newline 196 | ] 197 | ) 198 | ] 199 | ] 200 | parse db rule: [ 201 | [none! | into cookies] 202 | any [ 203 | set value string! (insert domain value) 204 | [into rule (remove domain) | none] 205 | ] 206 | ] 207 | ] 208 | ] 209 | 210 | { 211 | #test [ 212 | 213 | ] 214 | 215 | probe cookies/store ".test.com" "/" "CUSTOMER=WILE_E_COYOTE; path=/; expires=Wednesday, 09-Nov-2006 23:12:40 GMT" 216 | probe cookies/store "test.com" "/" "SHIPPING=FEDEX; path=/foo" 217 | probe cookies/store "test.com" "/" "SID=AZERTYUIOP; path=/foo; max-age=10000" 218 | probe cookies/build "test.com" "/" 219 | probe cookies/build "test.com" "/foo" 220 | probe cookies/store "localhost" "/toto/" "Titi=3" 221 | Set-Cookie: FPB=i3uitkb7r12eh2h1; expires=Thu, 01 Jun 2006 19:00:00 GMT; path=/; domain=www.yahoo.com 222 | cookies/show 223 | ;halt 224 | 225 | } 226 | 227 | -------------------------------------------------------------------------------- /UniServe/libs/decode-cgi.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Decode-cgi library" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.0.0 5 | Date: 26/06/2007 6 | ] 7 | 8 | context [ 9 | chars: complement charset "&=" 10 | 11 | set 'decode-cgi func [ 12 | data [any-string!] 13 | /raw 14 | /with list 15 | /local out type! name value s pos 16 | ][ 17 | out: any [list make block! 8] 18 | type!: any [all [raw word!] set-word!] 19 | parse/all data [ 20 | any [ 21 | #"&" 22 | | copy name some chars opt #"=" opt [copy value some chars] ( 23 | value: any [value ""] 24 | parse/all value [any [s: #"+" (change s #" ") | skip]] 25 | value: dehex value 26 | either pos: find/skip out name: to type! name 2 [ 27 | insert tail any [ 28 | all [block? s: second pos s] 29 | poke pos 2 reduce [s] 30 | ] value 31 | ][ 32 | insert tail out name 33 | insert tail out value 34 | ] 35 | value: none 36 | ) 37 | ] 38 | ] 39 | out 40 | ] 41 | ] 42 | -------------------------------------------------------------------------------- /UniServe/libs/email.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Email sending library" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.1.0 5 | ] 6 | 7 | email: context [ 8 | charset-str: none 9 | root: join what-dir %outgoing/ 10 | random/seed now/time/precise 11 | 12 | server: make system/standard/port [ 13 | scheme: 'tcp 14 | host: 127.0.0.1 15 | port-id: any [ 16 | all [ 17 | value? 'servers-port 18 | block? servers-port 19 | servers-port/MTA 20 | ] 21 | 9803 22 | ] 23 | ] 24 | 25 | system/standard/email: make system/standard/email [ 26 | MIME-Version: "1.0" 27 | Content-Transfer-Encoding: "8bit" 28 | X-Rebol: none 29 | attach: charset: report: none 30 | ] 31 | 32 | export: func [obj [object!] /local out][ 33 | out: make string! 512 34 | foreach [n v] third obj [if v [repend out [n ": " v crlf]]] 35 | out 36 | ] 37 | 38 | make-mime-header: func [file][ 39 | export context [ 40 | Content-Type: join {application/octet-stream; name="} [file {"}] 41 | Content-Transfer-Encoding: "base64" 42 | Content-Disposition: join {attachment; filename="} [file {"^M^/}] 43 | ] 44 | ] 45 | 46 | break-lines: func [msg data /local num][ 47 | num: 72 48 | while [not tail? data] [ 49 | insert/part tail msg data num 50 | insert tail msg crlf 51 | data: skip data num 52 | ] 53 | msg 54 | ] 55 | 56 | build-attach-body: func [ 57 | body [string!] 58 | files [block!] {List of files to send [%file1.r [%file2.r "data"]]} 59 | boundary [string!] 60 | ctype 61 | /local file val 62 | ][ 63 | if not empty? files [ 64 | insert body reduce [boundary ctype] 65 | append body "^M^/^M^/" 66 | if not parse files [ 67 | some [ 68 | (file: none) 69 | [ 70 | set file file! (val: read/binary file) 71 | | into [ 72 | set file file! 73 | set val skip ;anything allowed 74 | to end 75 | ] 76 | ] ( 77 | if file [ 78 | repend body [ 79 | boundary "^M^/" 80 | make-mime-header any [find/last/tail file #"/" file] 81 | ] 82 | val: either any-string? val [val] [mold :val] 83 | break-lines body enbase val 84 | ] 85 | ) 86 | ] 87 | ] [net-error "Cannot parse file list."] 88 | append body join boundary "--^M^/" 89 | ] 90 | body 91 | ] 92 | 93 | not-ascii7: charset [#"^(00)" - #"^(1F)" #"^(80)" - #"^(ff)"] 94 | not-ascii7-strict: union not-ascii7 charset " " 95 | 96 | encode-word: func [s [string!]][ ;-- RFC 2047 encoding 97 | if not find s not-ascii7 [return s] 98 | s: convert s [not-ascii7-strict][ 99 | either value/1 = #" " [#"_"][ 100 | as-string back insert skip to-hex to integer! value/1 6 #"=" 101 | ] 102 | ] 103 | insert s reduce ["=?" charset-str "?Q?"] 104 | append s "?=" 105 | ] 106 | 107 | encode-contacts: func [list header /local out][ 108 | out: make string! 20 109 | if all [2 = length? header string? header/1][header: reduce [header]] 110 | foreach eml header [ 111 | either block? eml [ 112 | append out reduce [encode-word eml/1 " <" eml/2 ">, "] 113 | eml: eml/2 114 | ][ 115 | append out eml 116 | append out ", " 117 | ] 118 | append list any [all [email? eml eml] to email! eml] 119 | ] 120 | head clear back back tail out 121 | ] 122 | 123 | blockify: func [value][any [all [not block? value reduce [value]] value]] 124 | 125 | add-header: func [msg [string!]][head insert msg debase/base to-hex length? msg 16] 126 | 127 | make-filename: has [name][ 128 | name: make file! 8 129 | until [ 130 | clear name 131 | loop 8 [append name #"`" + random 26] 132 | not exists? root/:name 133 | ] 134 | name 135 | ] 136 | 137 | set 'send-email func [h [block!] msg [string!] /local bound name from t-list id report v][ 138 | if not exists? root [make-dir root] 139 | h: make system/standard/email h 140 | 141 | charset-str: any [h/charset "ISO-8859-1"] 142 | h/charset: none 143 | 144 | if string? h/from [h/from: to-email h/from] 145 | if string? h/to [h/to: to-email h/to] 146 | 147 | foreach name [from to subject][ 148 | if any [none? h/:name empty? h/:name][ 149 | make error! join "Incomplete email specification, lacks : " mold name 150 | ] 151 | ] 152 | t-list: make block! length? h/to 153 | h/to: encode-contacts t-list blockify h/to 154 | if h/cc [h/cc: encode-contacts t-list blockify h/cc] 155 | if h/bcc [ 156 | foreach eml blockify h/bcc [append t-list to email! either block? eml [eml/2][eml/1]] 157 | h/bcc: none 158 | ] 159 | h/from: encode-contacts from: copy [] blockify h/from 160 | 161 | h/subject: encode-word h/subject 162 | if none? h/date [h/date: to-idate now] 163 | 164 | if h/report [ 165 | report: h/report 166 | forall report [if set-word? report/1 [report/1: to word! report/1]] 167 | report: head report 168 | if block? v: report/from [v/1: encode-word v/1] 169 | if v: report/subject [v: encode-word v] 170 | if word? v: report/body [report/body: get v] 171 | h/report: none 172 | ] 173 | 174 | msg: copy msg 175 | replace/all msg "^/" crlf 176 | 177 | either h/attach [ 178 | bound: rejoin ["--__REBOL--CHEYENNE--RSP--" checksum form now/precise "__"] 179 | h/MIME-Version: "1.0" 180 | h/Content-Type: join "multipart/mixed; boundary=" [{"} skip bound 2 {"}] 181 | h/Content-Transfer-Encoding: none 182 | msg: build-attach-body msg blockify h/attach bound rejoin [ 183 | {^M^/Content-Type: text/plain; charset="} charset-str {"^M^/} 184 | {Content-Transfer-Encoding: 8bit^M^/^M^/} 185 | ] 186 | insert msg crlf 187 | h/attach: none 188 | ][ 189 | h/Content-Type: rejoin [ {text/plain; charset="} charset-str {"}] 190 | ] 191 | 192 | h: export h 193 | msg: append append h crlf msg 194 | replace/all msg "^/." "^/.." 195 | name: make-filename 196 | write/binary root/:name msg 197 | 198 | id: checksum append h random 999999 199 | msg: mold/all reduce [from/1 t-list name id report] 200 | write/direct/no-wait/binary server add-header msg 201 | id 202 | ] 203 | 204 | set 'email-info? func [id [integer!] /local p res][ 205 | attempt [ 206 | p: open/direct server 207 | insert p add-header join "I" id 208 | res: load copy p 209 | close p 210 | res 211 | ] 212 | ] 213 | ] 214 | 215 | protect [send-email email-info?] -------------------------------------------------------------------------------- /UniServe/libs/encap-fs.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Encap virtual filesystem" 3 | Date: 21/09/2009 4 | ] 5 | 6 | encap-fs: context [ 7 | verbose: 0 8 | cache: none 9 | root: system/script/path 10 | rebol-files: [%.r] 11 | 12 | get-cache: func [file][ 13 | if verbose > 0 [print ["[encap-fs] cache read :" mold file]] 14 | if verbose > 1 [print ["[encap-fs] translated :" mold join root file]] 15 | either file [ 16 | select cache file 17 | ][ 18 | make error! join "Cannot access : " file 19 | ] 20 | ] 21 | 22 | set 'encap? to-logic select system/components 'decap 23 | 24 | either encap? [ 25 | set 'set-cache none 26 | set 'do-cache func [file [file!]][do any [get-cache file file]] 27 | set 'load-cache func [file [file!]][ 28 | either block? file: any [get-cache file file][ 29 | file 30 | ][ 31 | load as-string file 32 | ] 33 | ] 34 | set 'load-cache-binary func [file [file!]][ 35 | load any [get-cache file file] 36 | ] 37 | set 'read-cache func [file [file!]][any [get-cache file read file]] 38 | set 'exists?-cache func [file [file!]][to logic! find cache file] 39 | ][ 40 | set 'set-cache func [list [block!] /local out cdir emit rule name stk][ 41 | out: copy "REBOL []^/encap-fs/cache: [" 42 | cdir: %"" 43 | stk: reduce [copy cdir] 44 | emit: func [file][ 45 | file: mold file 46 | insert tail out "^/^-" 47 | insert tail out file 48 | either find rebol-files suffix? file [ 49 | insert tail out "^-^-[#include " 50 | insert tail out file 51 | insert tail out "]" 52 | ][ 53 | insert tail out "^-^-#include-binary " 54 | insert tail out file 55 | ] 56 | 57 | ] 58 | rule: [ 59 | some [ 60 | set name [file! | path! | word!] ( 61 | if not file? :name [name: do reduce [:name]] 62 | either slash = last name [ 63 | append stk copy append cdir name 64 | ][ 65 | emit join cdir name 66 | ] 67 | )[ 68 | into rule ( 69 | remove back tail stk 70 | cdir: copy last stk 71 | ) | none 72 | ] 73 | ] 74 | ] 75 | parse list rule 76 | append out "^/]" 77 | write %.cache.efs out 78 | ] 79 | set 'exists?-cache :exists? 80 | set 'do-cache func [file][do load file] 81 | set 'load-cache set 'load-cache-binary: :load 82 | set 'read-cache :read 83 | ] 84 | ] -------------------------------------------------------------------------------- /UniServe/libs/headers.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "HTTP Headers lib" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.0.0 5 | Comment: { 6 | A header block is a simple structure fo storing HTTP header name/value pairs. 7 | Each name is unique in the structure. Values can be : none!, a string! 8 | or a block of string!. 9 | 10 | structure: [ 11 | name1 "value1" | ["value1" "value2" ...] | none 12 | name2 ... 13 | ] 14 | } 15 | ] 16 | 17 | h-store: func [ 18 | "Store a header name/value pair in a header block" 19 | headers [block!] "Header block" 20 | name [word! string!] "Header Name" 21 | value [string! none!] "Value to store" 22 | /locals pos 23 | ][ 24 | either pos: find headers name [ 25 | either block? pos/2 [ 26 | insert tail pos/2 value 27 | ][ 28 | poke pos 2 any [ 29 | all [ 30 | find [Set-Cookie Set-Cookie2] name 31 | pos/2 32 | reduce [pos/2 value] 33 | ] value 34 | ] 35 | ] 36 | ][ 37 | insert tail headers name 38 | insert tail headers value 39 | ] 40 | ] 41 | 42 | foreach-nv-pair: func [ 43 | {Iterates through a block header and evaluates the body block 44 | for each name/value pair found. None! values will be skipped 45 | 'Name and 'Value words are exposed in the body block} 46 | headers [block!] "Header block" 47 | body [block!] "Body to evaluate for each pair" 48 | ][ 49 | foreach [name value] headers [ 50 | bind body 'name 51 | either block? value [ 52 | foreach val value [value: val do body] 53 | ][ 54 | do body 55 | ] 56 | ] 57 | ] 58 | 59 | form-header: func [ 60 | "Build a string with all the name/value pairs in a header block" 61 | headers [block!] "Header block" 62 | /local out 63 | ][ 64 | out: make string! 512 65 | foreach-nv-pair headers [ 66 | if value [insert tail out reduce [name ": " value crlf]] 67 | ] 68 | insert tail out crlf 69 | copy out ;-- TBD: investiguate on this 'copy 70 | ] -------------------------------------------------------------------------------- /UniServe/libs/html.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "URL and HTML codecs library" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 2.0.1 5 | Date: 15/08/2009 6 | ] 7 | 8 | set 'convert func [ 9 | "Rule-based string series conversion. Returns a new series." 10 | series [any-string!] "input string (unmodified)" 11 | rule [block!] "matching patterns described by a PARSE rule" 12 | body [block!] { 13 | Body evaluated on matched pattern. 14 | VALUE word refers to the matched pattern. 15 | OUT word refers to the new series. 16 | You have to return the new converted value. 17 | 18 | Do not use '__s and '__e words in the body. 19 | } 20 | /thru skip-rule [block!] "skip over these patterns without converting" 21 | /local out specs value __s __e 22 | ][ 23 | out: make string! length? series 24 | bind body 'out 25 | specs: [ 26 | __e: copy value rule ( 27 | insert/part tail out __s __e 28 | insert tail out do body 29 | ) __s: | skip 30 | ] 31 | if thru [insert specs: copy specs [skip-rule |]] 32 | parse/all series [ 33 | __s: any specs __e: 34 | (insert/part tail out __s __e) 35 | ] 36 | out 37 | ] 38 | 39 | context [ 40 | alphanum: charset [#"0" - #"9" #"a" - #"z" #"A" - #"Z"] 41 | entbase: charset ["^"&" #"^(A0)" - #"^(FF)"] 42 | entchar: union entbase charset "<>" 43 | url-special: charset "$-_.+!*'()," 44 | url-reserved: charset "&/:;=?@" 45 | url-not-allowed: reduce [ 46 | complement union alphanum url-special 47 | complement union alphanum union url-special url-reserved 48 | ] 49 | 50 | ; -- ASCII and ISO-8859-1 entities 51 | entities: make hash! [ 52 | """ #"^(22)" "¾" #"^(BE)" "à" #"^(E0)" 53 | "&" #"^(26)" "¿" #"^(BF)" "á" #"^(E1)" 54 | "<" #"^(3C)" "À" #"^(C0)" "â" #"^(E2)" 55 | ">" #"^(3E)" "Á" #"^(C1)" "ã" #"^(E3)" 56 | " " #"^(A0)" "Â" #"^(C2)" "ä" #"^(E4)" 57 | "¡" #"^(A1)" "Ã" #"^(C3)" "å" #"^(E5)" 58 | "¢" #"^(A2)" "Ä" #"^(C4)" "æ" #"^(E6)" 59 | "£" #"^(A3)" "Å" #"^(C5)" "ç" #"^(E7)" 60 | "¤" #"^(A4)" "Æ" #"^(C6)" "è" #"^(E8)" 61 | "¥" #"^(A5)" "Ç" #"^(C7)" "é" #"^(E9)" 62 | "¦" #"^(A6)" "È" #"^(C8)" "ê" #"^(EA)" 63 | "§" #"^(A7)" "É" #"^(C9)" "ë" #"^(EB)" 64 | "¨" #"^(A8)" "Ê" #"^(CA)" "ì" #"^(EC)" 65 | "©" #"^(A9)" "Ë" #"^(CB)" "í" #"^(ED)" 66 | "ª" #"^(AA)" "Ì" #"^(CC)" "î" #"^(EE)" 67 | "«" #"^(AB)" "Í" #"^(CD)" "ï" #"^(EF)" 68 | "¬" #"^(AC)" "Î" #"^(CE)" "ð" #"^(F0)" 69 | "­" #"^(AD)" "Ï" #"^(CF)" "ñ" #"^(F1)" 70 | "®" #"^(AE)" "Ð" #"^(D0)" "ò" #"^(F2)" 71 | "¯" #"^(AF)" "Ñ" #"^(D1)" "ó" #"^(F3)" 72 | "°" #"^(B0)" "Ò" #"^(D2)" "ô" #"^(F4)" 73 | "±" #"^(B1)" "Ó" #"^(D3)" "õ" #"^(F5)" 74 | "²" #"^(B2)" "Ô" #"^(D4)" "ö" #"^(F6)" 75 | "³" #"^(B3)" "Õ" #"^(D5)" "÷" #"^(F7)" 76 | "´" #"^(B4)" "Ö" #"^(D6)" "ø" #"^(F8)" 77 | "µ" #"^(B5)" "×" #"^(D7)" "ù" #"^(F9)" 78 | "¶" #"^(B6)" "Ø" #"^(D8)" "ú" #"^(FA)" 79 | "·" #"^(B7)" "Ù" #"^(D9)" "û" #"^(FB)" 80 | "¸" #"^(B8)" "Ú" #"^(DA)" "ü" #"^(FC)" 81 | "¹" #"^(B9)" "Û" #"^(DB)" "ý" #"^(FD)" 82 | "º" #"^(BA)" "Ü" #"^(DC)" "þ" #"^(FE)" 83 | "»" #"^(BB)" "Ý" #"^(DD)" "ÿ" #"^(FF)" 84 | "¼" #"^(BC)" "Þ" #"^(DE)" 85 | "½" #"^(BD)" "ß" #"^(DF)" 86 | 87 | ] 88 | 89 | set 'html-decode func [data [string! binary!]][ 90 | convert data [#"&" 2 6 alphanum #";"][ 91 | any [select entities value value] 92 | ] 93 | ] 94 | 95 | set 'html-encode func [data [string! binary!] /no-tags][ 96 | convert/thru data [entchar][ 97 | pick find entities to char! value -1 98 | ][ 99 | #"&" opt #"#" 2 6 alphanum #";" 100 | ] 101 | ] 102 | 103 | set 'entities-encode func [data [string! binary!] /no-tags][ 104 | convert data [entbase][ 105 | pick find entities to char! value -1 106 | ] 107 | ] 108 | 109 | set 'url-encode func [data [string! url!] /all /local chars][ 110 | chars: pick url-not-allowed to logic! all 111 | convert data [chars][ 112 | reduce [#"%" skip to-hex to integer! to char! value 6] 113 | ] 114 | ] 115 | ] -------------------------------------------------------------------------------- /UniServe/libs/idate.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | context [ 4 | digit: charset "0123456789" 5 | blank: #" " 6 | 7 | days: ["Mon," "Tue," "Wed," "Thu," "Fri," "Sat," "Sun,"] 8 | months: ["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] 9 | 10 | set 'prefix0 func [time [time!]][ 11 | time: either time/hour < 10 [head insert mold time #"0"][mold time] 12 | if 5 = length? time [append time ":00"] 13 | time 14 | ] 15 | 16 | set 'to-UTC func [date [date!]][date - date/zone] 17 | 18 | set 'to-GMT-idate func [date [date!] /UTC /local cache str new][ 19 | cache: #[hash! []] 20 | if UTC [date: to-UTC date] 21 | either str: select cache date [str][ 22 | insert tail cache date 23 | insert tail cache new: form reduce [ 24 | pick days date/weekday 25 | join any [all [date/day < 10 #"0"] ""] date/day 26 | pick months date/month 27 | date/year 28 | prefix0 any [date/time 0:0] 29 | "GMT" 30 | ] 31 | if 200 < length? cache [clear cache] ;-- 100 dates cached max 32 | new 33 | ] 34 | ] 35 | 36 | set 'to-CLF-idate func [date [date!] /local cache tmp dt][ 37 | cache: #[hash! [0:00:01 ""]] 38 | either date = first cache [second cache][ 39 | cache/1: date 40 | dt: clear cache/2 41 | insert tail dt #"[" 42 | if date/day < 10 [insert tail dt #"0"] 43 | insert tail dt date/day 44 | insert tail dt slash 45 | insert tail dt pick months date/month 46 | insert tail dt slash 47 | insert tail dt date/year 48 | insert tail dt #":" 49 | tmp: date/time 50 | if tmp/hour < 10 [insert tail dt #"0"] 51 | insert tail dt tmp 52 | if zero? tmp/second [insert tail dt ":00"] 53 | insert tail dt #" " 54 | insert tail dt any [all [negative? date/zone #"-"] #"+"] 55 | if lesser? tmp: date/zone/hour 10 [insert tail dt #"0"] 56 | insert tail dt abs tmp 57 | if lesser? tmp: date/zone/minute 10 [insert tail dt #"0"] 58 | insert tail dt tmp 59 | insert tail dt #"]" 60 | dt 61 | ] 62 | ] 63 | 64 | set 'to-rebol-date func [data [string!] /local asc pos][ 65 | parse/all data [thru blank data: [digit (asc: yes) | (asc: no)]] 66 | if pos: find data #";" [clear pos] 67 | if not asc [ 68 | data: parse data none 69 | insert data second data 70 | change at data 3 fifth data 71 | remove back tail data 72 | data: form data 73 | ] 74 | attempt [to date! data] 75 | ] 76 | ] -------------------------------------------------------------------------------- /UniServe/libs/log.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Log Object Definition" 3 | Purpose: "Provides an easy way to log messages to screen/file" 4 | File: %log.r 5 | Version: 1.2.0 6 | ] 7 | 8 | logger: context [ 9 | level: 'screen ; 'screen, 'file, 'csv, 'both, none 10 | file: %activity 11 | file.log: join file %.log 12 | file.csv: join file %.csv 13 | col: #":" 14 | zero: #"0" 15 | dot: #"." 16 | 17 | notify: func [msg module [word!] type [word!] /local out time size][ 18 | if none? level [exit] 19 | out: msg 20 | if block? out [out: rejoin out] 21 | if not string? out [out: mold out] 22 | uppercase/part out 1 23 | out: reform switch type [ 24 | warn [["# Warning in" mold reduce [module] ":" out "!"]] 25 | error [["## Error in" mold reduce [module] ":" out "!"]] 26 | fatal [["### FATAL in" mold reduce [module] ":" out "!"]] 27 | info [[mold reduce [module] out]] 28 | ] 29 | time: mold now/time/precise 30 | size: pick [12 15] system/version/4 = 3 31 | if 8 = length? time [append time dot] 32 | insert/dup tail time zero size - length? time 33 | 34 | out: rejoin [now/day "/" now/month "-" time "-" out] 35 | switch level [ 36 | screen [system/words/print out] 37 | file [write/append file.log append out newline] 38 | both [ 39 | system/words/print out 40 | write/append file.log append out newline 41 | ] 42 | csv [ 43 | switch type [ 44 | warn [type: 'Warning] 45 | error [type: 'Error] 46 | info [type: 'Info] 47 | ] 48 | write/append file.csv rejoin [ 49 | mold time ";" 50 | mold type ";" 51 | mold module ";" 52 | mold uppercase/part msg 1 53 | newline 54 | ] 55 | ] 56 | ] 57 | ] 58 | ] 59 | 60 | log-class: context [ 61 | name: 'log-class 62 | 63 | log: func [msg /warn /error /info /fatal][ 64 | case [ 65 | warn [logger/notify msg name 'warn] 66 | error [logger/notify msg name 'error] 67 | info [logger/notify msg name 'info] 68 | fatal [logger/notify msg name 'fatal] 69 | ] 70 | ] 71 | ] 72 | 73 | ;-- extends an existing object with log func (name words needs to be defined in obj) 74 | log-install: func [name [word!] /local obj f][ 75 | obj: get name 76 | obj/log: func first f: get in log-class 'log bind/copy second :f obj 77 | obj/name: name 78 | ] -------------------------------------------------------------------------------- /UniServe/libs/url.r: -------------------------------------------------------------------------------- 1 | REBOL [] 2 | 3 | context [ 4 | digit: charset "0123456789" 5 | alpha: charset [#"a" - #"z" #"A" - #"Z" "-_%"] 6 | alphanum: union alpha digit 7 | host-char: complement charset "@:/" 8 | v1: v2: v3: v4: v5: v6: v7: none 9 | 10 | obj: context [ 11 | scheme: user: pass: host: port-id: path: target: none 12 | ] 13 | 14 | set 'parse-url func [url [string! url!]][ 15 | v1: v2: v3: v4: v5: v6: v7: none 16 | parse/all url [ 17 | copy v1 to "://" 3 skip (v1: to word! v1) [ 18 | copy v2 any host-char [ 19 | #":" copy v3 any host-char 20 | | (v3: none) none 21 | ] #"@" 22 | | (v2: v3: none) none 23 | ] 24 | copy v4 any host-char [ 25 | #":" copy v5 1 5 digit (v5: to integer! v5) 26 | | (v5: none) none 27 | ][ 28 | end 29 | | [ 30 | [ 31 | copy v6 [slash any [some alphanum slash]] 32 | | none 33 | ] 34 | [copy v7 to end] 35 | ] 36 | ] 37 | ] 38 | obj/scheme: v1 39 | obj/user: v2 40 | obj/pass: v3 41 | obj/host: v4 42 | obj/port-id: v5 43 | obj/path: v6 44 | obj/target: v7 45 | obj 46 | ] 47 | ] 48 | -------------------------------------------------------------------------------- /UniServe/protocols/DNS.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "DNS Async wrapper" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.1.0 5 | Date: 20/09/2009 6 | ] 7 | 8 | install-protocol [ 9 | name: 'DNS 10 | scheme: 'dns 11 | 12 | on-received: func [data][ 13 | on-resolved server data 14 | ] 15 | 16 | events: [ 17 | on-resolved ; [port [port!] ip [tuple! none!]] 18 | on-error ; [port code] 19 | ] 20 | ] -------------------------------------------------------------------------------- /UniServe/protocols/FastCGI.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "FastCGI client protocol" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.2.0 5 | Date: 10/12/2007 6 | ] 7 | 8 | do-cache uniserve-path/libs/headers.r 9 | 10 | install-protocol [ 11 | name: 'FastCGI 12 | port-id: 8000 13 | 14 | seq-id: 1 15 | out: make string! 1024 * 10 16 | ;req-ctx: none ; not re-entrant for multiple fastcgi connections ! 17 | 18 | ;--- Low-level I/O --- 19 | 20 | b0: b1: b2: b3: int: int24: mark: bytes: expected: none 21 | 22 | read-byte: [copy byte skip (byte: to integer! to char! :byte)] 23 | read-nbytes: [mark: (bytes: copy/part mark expected mark: skip mark expected) :mark] 24 | read-int: [ 25 | read-byte (b1: byte) 26 | read-byte (b0: byte int: b0 + (256 * b1)) 27 | ] 28 | read-int24: [ 29 | read-byte (b2: byte) 30 | read-byte (b1: byte) 31 | read-byte (b0: byte int24: b0 + (256 * b1) + (65536 * b2)) 32 | ] 33 | 34 | write-int16: func [value [integer!]][ 35 | join to char! value / 256 to char! value // 256 36 | ] 37 | 38 | ;--- --- 39 | 40 | defs: [ 41 | misc [ 42 | header-len 8 ; Number of bytes in a fcgi_header 43 | version 1 ; Value for version component of fcgi_header 44 | null-request-id 0 45 | ] 46 | role [ 47 | 1 begin-request 48 | 2 abort-request 49 | 3 end-request 50 | 4 params 51 | 5 stdin 52 | 6 stdout 53 | 7 stderr 54 | 8 data 55 | 9 get-values 56 | 10 get-values-result 57 | 11 unknown-type 58 | ] 59 | mask [ 60 | keep-conn 1 ; Mask for flags component of FCGI_BeginRequestBody 61 | ] 62 | begin-role [ 63 | 1 responder 64 | 2 authorizer 65 | 3 filter 66 | ] 67 | end-role [ 68 | 0 request-complete 69 | 1 cant-mpx-conn 70 | 2 overloaded 71 | 3 unknown-role 72 | ] 73 | values [ 74 | "FCGI_MAX_CONNS" "" 75 | "FCGI_MAX_REQS" "" 76 | "FCGI_MPXS_CONNS" "" 77 | ] 78 | ] 79 | 80 | decode-role: func [value [integer!]][ 81 | any [select defs/role value 'unknown] 82 | ] 83 | 84 | encode-role: func [value [word!]][ 85 | first back find defs/role value 86 | ] 87 | 88 | decode-begin-role: func [value [integer!]][ 89 | any [select defs/begin-role value 'unknown] 90 | ] 91 | 92 | decode-end-role: func [value [integer!]][ 93 | any [select defs/end-role value 'unknown] 94 | ] 95 | 96 | make-nv-pairs: func [data /local len][ 97 | clear out 98 | foreach-nv-pair data [ 99 | if value [ 100 | insert tail out to char! length? name: form name 101 | insert tail out either 127 < len: length? value [ 102 | #{80000000} or debase/base to-hex len 16 103 | ][ 104 | to char! len 105 | ] 106 | insert tail out name 107 | insert tail out value 108 | ] 109 | ] 110 | out 111 | ] 112 | 113 | make-record: func [content [any-string!] type [word!] id [integer!] /local sz][ 114 | head insert/part tail rejoin [ 115 | #"^(01)" 116 | to char! encode-role type 117 | write-int16 id 118 | write-int16 sz: min 65535 length? content 119 | #"^(00)" 120 | #"^(00)" 121 | ] content sz 122 | ] 123 | 124 | send-cmd: func [cmd [word!] id /ext data][ 125 | write-server switch cmd [ 126 | begin [make-record #{0001010000000000} 'begin-request id] 127 | params [make-record any [all [ext make-nv-pairs data] ""] 'params id] 128 | stdin [make-record any [data ""] 'stdin id] 129 | values [make-record make-nv-pairs defs/values 'get-values id] 130 | ] 131 | ] 132 | 133 | CGI-format: func [blk][ 134 | forall blk [ 135 | change blk join "HTTP_" replace/all uppercase form blk/1 #"-" #"_" 136 | blk: next blk 137 | ] 138 | head blk 139 | ] 140 | 141 | make-new-request: func [id][ 142 | repend server/user-data/queue [ 143 | id context [ 144 | state: 'header 145 | padding: 0 146 | stdout: stderr: type: none 147 | ] 148 | ] 149 | ] 150 | 151 | stop-at: defs/misc/header-len 152 | 153 | on-connected: does [ 154 | set-modes server [keep-alive: true] 155 | server/user-data: context [ 156 | req-ctx: none 157 | queue: make block! 16 158 | ] 159 | on-ready server 160 | ] 161 | 162 | on-received: func [data /local su req len][ 163 | ;foreach [id req] server/user-data/queue [print [id type? req]] 164 | su: server/user-data 165 | req: any [ 166 | su/req-ctx 167 | all [ 168 | server/id: (to integer! data/3) * 256 + data/4 169 | su/req-ctx: select su/queue server/id 170 | ] 171 | ] 172 | switch req/state [ 173 | header [ 174 | req/type: decode-role second data 175 | req/padding: to integer! pick data 7 176 | len: (to integer! data/5) * 256 + data/6 + req/padding 177 | if not zero? len [ 178 | stop-at: len 179 | req/state: 'content 180 | ] 181 | ] 182 | content [ 183 | switch req/type [ 184 | stdout [ 185 | if not req/stdout [req/stdout: make string! 1024 * 10] 186 | either zero? req/padding [ 187 | append req/stdout data 188 | ][ 189 | insert/part tail req/stdout data stop-at - req/padding 190 | ] 191 | ] 192 | stderr [ 193 | if not req/stderr [req/stderr: make string! 1024 * 10] 194 | either zero? req/padding [ 195 | append req/stderr data 196 | ][ 197 | insert/part tail req/stderr data stop-at - req/padding 198 | ] 199 | ] 200 | end-request [ 201 | if not zero? len: to integer! data/5 [ 202 | log/warn reform ["response error:" decode-end-role len] 203 | ] 204 | on-response server req/stdout req/stderr 205 | remove/part back find su/queue su/req-ctx 2 206 | ;remove/part find server/user-data server/id 2 207 | su/req-ctx: none 208 | ] 209 | get-values-result [ 210 | su/req-ctx: none 211 | ?? data 212 | ] 213 | ] 214 | req/state: 'header 215 | stop-at: defs/misc/header-len 216 | ] 217 | ] 218 | ] 219 | 220 | new-insert-port: func [port req [object!] /local id][ 221 | make-new-request id: port/id 222 | send-cmd 'begin id 223 | 224 | send-cmd/ext 'params id reduce [ 225 | "SERVER_SOFTWARE" "Cheyenne/1.0" 226 | "SERVER_NAME" system/network/host 227 | "GATEWAY_INTERFACE" "CGI/1.1" 228 | "SERVER_PORT" form req/client/local-port 229 | "REQUEST_METHOD" req/method 230 | "PATH_INFO" at req/url 1 + length? req/script 231 | "PATH_TRANSLATED" req/path 232 | "SCRIPT_FILENAME" req/path 233 | "REQUEST_URI" req/url 234 | "SCRIPT_NAME" req/script 235 | "QUERY_STRING" req/query 236 | ;"REMOTE_HOST" none 237 | "REMOTE_ADDR" form req/client/remote-ip 238 | "AUTH_TYPE" req/auth-type 239 | "REMOTE_USER" req/user 240 | ;"REMOTE_IDENT" none 241 | "CONTENT_LENGTH" req/cnt-length 242 | "CONTENT_TYPE" req/cnt-type 243 | ] 244 | send-cmd/ext 'params id CGI-format req/headers 245 | send-cmd 'params id 246 | if req/content [ 247 | while [positive? length? req/content][ 248 | send-cmd/ext 'stdin id req/content 249 | req/content: skip req/content 65535 250 | ] 251 | ] 252 | send-cmd 'stdin id 253 | ;seq-id: seq-id + 1 ; TBD: decide to manage IDs at the protocol level, or not 254 | ] 255 | 256 | on-close-server: has [req su][ 257 | ;print "closing, trying to catch last one" 258 | su: server/user-data 259 | if not empty? su/queue [ ; try to finish the last request if any 260 | server/id: su/queue/1 261 | req: su/queue/2 262 | ;print ["found ID : " server/id] 263 | if any [req/stdout req/stderr][ 264 | on-response server req/stdout req/stderr 265 | ] 266 | ] 267 | su/req-ctx: none ; ?? really useful ?? 268 | on-closed server 269 | false 270 | ] 271 | 272 | events: [ 273 | on-response ; [port [port!] out [string!] err [string! none!]] 274 | on-ready ; [port!] 275 | on-closed ; [port!] 276 | ] 277 | ] 278 | 279 | fcgi-job-class: context [ 280 | id: url: info: path: script: query: auth-type: user: 281 | headers: content: cnt-length: cnt-type: client: none 282 | method: "GET" 283 | ] 284 | -------------------------------------------------------------------------------- /UniServe/protocols/SMTP.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "SMTP Async Protocol" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.0.2 5 | Date: 28/02/2010 6 | ] 7 | 8 | install-protocol [ 9 | name: 'SMTP 10 | port-id: 25 11 | verbose: 0 12 | connect-retries: 4 13 | 14 | stop-at: crlf 15 | whoami: system/network/host 16 | 17 | alpha-num: charset [#"A" - #"Z" "0123465789"] 18 | 19 | reset: does [stop-at: crlf] 20 | fire-event: does [on-sent server] 21 | 22 | on-loop: func [su data][ 23 | if all [ 24 | find/part data "250" 3 25 | parse data: skip data 4 [some alpha-num] 26 | ][ 27 | append su/flags load data 28 | ] 29 | ] 30 | 31 | on-connected: does [ 32 | server/timeout: 00:05 ; 5 mn (RFC) 33 | server/user-data: context [ 34 | state: 'ehlo 35 | id: random 99999999 36 | flags: make block! 1 37 | ] 38 | stop-at: crlf 39 | ] 40 | 41 | on-received: func [data /local su action job s][ 42 | job: server/task/job 43 | su: server/user-data 44 | if verbose > 2 [log/info trim/tail reform [su/id ">>" as-string data]] 45 | if verbose > 1 [log/info [su/id " state = " su/state]] 46 | 47 | either action: select [ 48 | helo ["220" [["HELO " whoami crlf]] mail] 49 | ehlo ["220" * [["EHLO " whoami crlf]] mail] 50 | mail ["250" * [["MAIL FROM:<" job/from "> BODY=8BITMIME" crlf]] rcpt] 51 | rcpt ["250" [["RCPT TO:<" server/task/to #">" crlf]] data] 52 | data ["250" ["DATA^M^/"] body] 53 | body ["354" [[%outgoing/ job/body] "^M^/.^M^/"] sent] 54 | sent ["250" ["QUIT^M^/"] quit] 55 | quit ["221" [fire-event] closed] 56 | ] su/state [ 57 | either any [action/1 = '- find/part data action/1 3][ 58 | if action/2 = '* [ 59 | if (length? server/locals/in-buffer) > length? data [ 60 | on-loop su data 61 | exit 62 | ] 63 | action: next action 64 | ] 65 | foreach s action/2 [ 66 | s: any [all [block? s rejoin s] :s] 67 | if all [0 < verbose verbose < 3][log/info rejoin [su/id " request >> " s]] 68 | either word? s [do s][ 69 | if verbose > 2 [log/info trim/tail reform [su/id "<<" as-string s]] 70 | write-server s 71 | ] 72 | ] 73 | su/state: action/3 74 | ][ 75 | close-server 76 | log/warn reform ["job:" mold job "^/*** Error:" as-string data] 77 | on-error server as-string data 78 | stop-at: none 79 | ] 80 | ][ 81 | log/error reform ["unknown state" mold su/state] 82 | ] 83 | ] 84 | 85 | events: [ 86 | on-sent ; [port] 87 | on-error ; [port reason [string!]] 88 | ] 89 | ] 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /UniServe/protocols/dig.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "DIG - DNS protocol" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Date: 01/09/2009 5 | Version: 1.0.0 6 | ] 7 | 8 | install-protocol [ 9 | name: 'dig 10 | port-id: 53 11 | scheme: 'udp 12 | verbose: 0 13 | 14 | strategy: 'round-robin ;-- alt: 'random 15 | dns-server: none 16 | domain-size: none 17 | zem?: no 18 | dot: #"." 19 | value: none 20 | 21 | defs: [ 22 | 1 A 23 | 2 NS 24 | 5 CNAME 25 | 6 SOA 26 | 7 MB 27 | 8 MG 28 | 9 MR 29 | 10 NULL 30 | 11 WKS 31 | 12 PTR 32 | 13 HINFO 33 | 14 MINFO 34 | 15 MX 35 | 16 TXT 36 | 17 ALL 37 | ] 38 | 39 | win-get-dns: has [base local-ip out v][ 40 | local-ip: mold read join dns:// read dns:// 41 | 42 | either value? 'get-reg [ 43 | base: "System\CurrentControlSet\Services\Tcpip\Parameters\Interfaces" 44 | foreach adapter list-reg/hklm base [ 45 | if local-ip = get-reg/hklm rejoin [base #"\" adapter] "IPAddress" [ 46 | v: get-reg/hklm rejoin [base #"\" adapter] "NameServer" 47 | v: parse v "," 48 | forall v [change v attempt [to-tuple trim v/1]] 49 | return head v 50 | ] 51 | ] 52 | ][ 53 | out: make string! 64000 54 | call/output/show "ipconfig /all" out 55 | parse out [thru local-ip thru "DNS" thru #":" copy v to newline] 56 | attempt [to-tuple trim v] 57 | ] 58 | ] 59 | 60 | unix-get-dns: has [conf ip][ 61 | if exists? conf: %/etc/resolv.conf [ 62 | parse read conf [ 63 | any [ 64 | thru "nameserver" copy ip to newline ( 65 | ip: attempt [load ip] 66 | return ip 67 | ) 68 | ] 69 | ] 70 | ] 71 | none 72 | ] 73 | 74 | either dns-server: any [ 75 | all [value: in uniserve/shared 'dns-server get value] 76 | either system/version/4 = 3 [win-get-dns][unix-get-dns] 77 | ][ 78 | share append/only [dns-server:] dns-server 79 | ][ 80 | log/error "DNS server not found" 81 | ] 82 | 83 | encode: func [name [string!] /local out][ 84 | out: make binary! length? name 85 | repeat token parse name "." [ 86 | insert tail out to char! length? token 87 | insert tail out token 88 | ] 89 | insert tail out #{00} 90 | domain-size: length? out 91 | out 92 | ] 93 | 94 | decode-name: func [data out /ptr /local len][ 95 | if zero? len: to integer! data/1 [ 96 | zem?: yes 97 | remove back tail out 98 | return next data 99 | ] 100 | either zero? len and 192 [ 101 | len: len and 63 102 | insert/part tail out next data len 103 | insert tail out dot 104 | either ptr [ 105 | decode-name/ptr at data 2 + len out 106 | skip data len + 2 107 | ][ 108 | skip data len + 1 109 | ] 110 | ][ 111 | len: to integer! (data/1 and 63) * 256 + data/2 112 | decode-name/ptr at head data 1 + len out 113 | skip data 2 114 | ] 115 | ] 116 | 117 | parse-name: func [p blk /local name][ 118 | zem?: no 119 | name: make string! 32 120 | until [p: decode-name p name zem?] 121 | append blk name 122 | p 123 | ] 124 | 125 | decode: func [data /local v b p len res type MX-rule A-rule NS-rule section-rule][ 126 | if none? data [return -99] 127 | 128 | MX-rule: [ 129 | copy v 2 skip (append blk to integer! as-binary v) 130 | p: (p: parse-name p blk) :p 131 | ] 132 | A-rule: [ 133 | copy v 4 skip (append blk to tuple! as-binary v) 134 | ] 135 | NS-rule: [ 136 | p: (p: parse-name p blk) :p 137 | ] 138 | section-rule: [ 139 | p: (p: parse-name p blk) :p 140 | copy v 2 skip (append blk type: select defs to integer! as-binary v) 141 | 2 skip 142 | copy v 4 skip (append blk to integer! as-binary v) 143 | 2 skip 144 | (rdata: get select [MX MX-rule A A-rule NS NS-rule] type) 145 | rdata 146 | ] 147 | parse/all/case data [ 148 | 2 skip 149 | copy v 2 skip ( 150 | if not zero? v: 15 and to integer! as-binary v [return negate v] 151 | res: make block! 3 152 | len: copy [0 0 0] 153 | ) 154 | 2 skip 155 | 3 [copy v 2 skip (len/1: to integer! as-binary v len: next len)] 156 | (len: head len) 157 | domain-size skip 158 | 4 skip 159 | (blk: make block! len/1) len/1 section-rule (append/only res new-line/all/skip blk on 5) 160 | (blk: make block! len/2) len/2 section-rule (append/only res new-line/all/skip blk on 4) 161 | (blk: make block! len/3) len/3 section-rule (append/only res new-line/all/skip blk on 4) 162 | ] 163 | new-line/all/skip res on 5 164 | ] 165 | 166 | on-connected: does [ 167 | new-insert-port server server/target 168 | if verbose > 1 [log/info ["connected to DNS server: " server/remote-ip]] 169 | ] 170 | 171 | on-init-port: func [port url /local domain][ 172 | port/target: port/host 173 | port/host: either tuple? dns-server [dns-server][ 174 | switch strategy [ 175 | round-robin [first head reverse dns-server] 176 | random [pick dns-server random length? dns-server] 177 | ] 178 | ] 179 | ] 180 | 181 | on-raw-received: func [data /local list pos][ 182 | on-response data: decode as-string data 183 | either integer? data [ 184 | if verbose > 2 [log/info ["error code " mold data]] 185 | on-error server "unknown domain" 186 | ][ 187 | either empty? data/1 [ 188 | on-error server "no MX record" 189 | ][ 190 | sort/skip/compare data/1 5 4 191 | list: extract/index data/1 5 5 192 | forall list [if pos: find data/3 list/1 [list/1: pick pos 4]] 193 | remove-each ip list: head list [none? ip] ;-- clean up the list 194 | 195 | if verbose > 0 [log/info ["MX for " server/target ":^/" mold new-line/all list on]] 196 | either not empty? list [ 197 | on-mx server list 198 | ][ 199 | on-error server "cannnot find MX record" 200 | ] 201 | ] 202 | ] 203 | close-server 204 | ] 205 | 206 | new-insert-port: func [port domain [string!] /local buf id][ 207 | buf: clear #{} 208 | id: (to integer! now/time) // 65025 209 | 210 | write-server repend buf [ 211 | to char! id / 255 212 | to char! id // 255 213 | #{01000001000000000000} 214 | encode domain 215 | #{000F0001} 216 | ] 217 | ] 218 | 219 | events: [ 220 | on-response ; [records] 221 | on-mx ; [ip [block!]] 222 | on-error ; [port code] 223 | ] 224 | 225 | if all [value? 'debug object? :debug][debug/print ["DNS server=" dns-server]] 226 | ] 227 | -------------------------------------------------------------------------------- /UniServe/services/RConsole.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Remote Console service" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Date: 27/05/2007 5 | Version: 1.1.0 6 | Purpose: "Provide a remote console service allowing remote REBOL expressions evaluation" 7 | ] 8 | 9 | netstat: has [pad][ 10 | pad: func [v n][ 11 | head insert/dup tail v: form v #" " n - length? v 12 | ] 13 | print ["wait-list length:" length? system/ports/wait-list newline] 14 | print "Scheme Port Client-IP Service Expire-time" 15 | print "----------------------------------------------------------" 16 | foreach p system/ports/wait-list [ 17 | print [ 18 | pad p/scheme 8 19 | pad p/port-id 6 20 | pad p/remote-ip 15 21 | pad attempt [p/locals/handler/name] 16 22 | pad attempt [p/locals/expire] 26 23 | ] 24 | ] 25 | ] 26 | 27 | install-service [ 28 | name: 'RConsole 29 | port-id: 9801 30 | verbose: 0 31 | out: make string! 100000 32 | 33 | stop-at: to-string to-char 255 34 | 35 | emit: func [value][write-client append value stop-at] 36 | 37 | print-funcs: reduce [ 38 | func [value][ 39 | append out form reduce :value 40 | append out newline 41 | unset 'value 42 | ] 43 | func [value][ 44 | append out form reduce :value 45 | unset 'value 46 | ] 47 | func [value][ 48 | append out mold :value 49 | append out newline 50 | :value 51 | ] 52 | ] 53 | 54 | ;--- Function borrowed from Gabriele Santilli 55 | form-error: func [errobj [object!] /all /local errtype text][ 56 | errtype: get in system/error get in errobj 'type 57 | text: get in errtype get in errobj 'id 58 | if block? text [text: reform bind/copy text in errobj 'self] 59 | either all [ 60 | rejoin [ 61 | "** " get in errtype 'type ": " text newline 62 | either get in errobj 'where [join "** Where: " [mold get in errobj 'where newline]] [""] 63 | either get in errobj 'near [join "** Near: " [mold/only get in errobj 'near newline]] [""] 64 | ] 65 | ][ 66 | text 67 | ] 68 | ] 69 | 70 | exec: func [data /local saved result][ 71 | saved: reduce [:print :prin :probe] 72 | set [print prin probe] print-funcs 73 | error? set/any 'result try load/all to-string data 74 | set [print prin probe] saved 75 | if any [unset? 'result not value? 'result][ 76 | emit out 77 | exit 78 | ] 79 | either error? :result [ 80 | append out form-error/all disarm :result 81 | ][ 82 | either any [ 83 | object? :result 84 | port? :result 85 | ][ 86 | append out newline 87 | ][ 88 | append out join "== " mold :result 89 | append out newline 90 | ] 91 | ] 92 | emit out 93 | ] 94 | 95 | on-new-client: does [ 96 | if not find [127.0.0.1] client/remote-ip [close-client] 97 | emit copy "Connected to UniServe^/Remote Console Service^/" 98 | ] 99 | 100 | on-received: func [data][ 101 | remove back tail data 102 | clear out 103 | exec data 104 | ] 105 | ] -------------------------------------------------------------------------------- /UniServe/services/logger.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Logger service" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Date: 02/01/2009 5 | Version: 1.0.0 6 | Purpose: "UniServe's remote message logging service" 7 | ] 8 | 9 | install-service [ 10 | name: 'Logger 11 | port-id: 9802 12 | verbose: 0 13 | 14 | trace-file: join system/options/path %trace.log 15 | error-file: join system/options/path %error.log 16 | 17 | on-started: has [pid][ 18 | if cheyenne/port-id [ 19 | pid: join "-" cheyenne/port-id/1 20 | insert find/reverse tail trace-file #"." pid 21 | insert find/reverse tail error-file #"." pid 22 | ] 23 | ] 24 | 25 | on-new-client: does [ 26 | if client/remote-ip <> 127.0.0.1 [close-client] 27 | stop-at: 4 28 | ] 29 | 30 | process: func [data /local file][ 31 | file: get pick [error-file trace-file] data/1 = #"E" 32 | write/append/direct file next data 33 | ] 34 | 35 | on-received: func [data][ 36 | either client/user-data = 'head [ 37 | if verbose > 0 [log/info join "new request: " to string! data] 38 | process data 39 | client/user-data: none 40 | stop-at: 4 41 | ][ 42 | client/user-data: 'head 43 | stop-at: 1 + to integer! data 44 | ] 45 | ] 46 | ] -------------------------------------------------------------------------------- /UniServe/services/task-master.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Uniserve: task-master service" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.4.0 5 | Date: 02/01/2009 6 | History: [ 7 | 1.4.0 - 02/01/2009 { 8 | o 'no-delay mode removed and replaced by 'keep-alive mode 9 | o 'resurrect? property added 10 | o fix a long standing bug in queued job module mismatching 11 | o 'on-reset callback added to allow restarting of all worker processes 12 | o minor clode cleanup 13 | } 14 | 1.3.0 - 06/06/2006 { 15 | o Added 'locals argument to all 'on-task-* callbacks 16 | } 17 | 1.2.0 - 17/01/2006 { 18 | o Added 'part message support triggering the new 'on-task-part callback. 19 | } 20 | 1.1.1 - 23/03/2005 { 21 | o Cleaner handling of errors for 'on-task-failed invocation. 22 | } 23 | 1.1.0 - 01/02/2005 { 24 | o Client/user-data added to the saved context for each task. 25 | } 26 | ] 27 | ] 28 | 29 | install-service [ 30 | name: 'task-master 31 | port-id: 9799 32 | ;hidden: yes 33 | verbose: 0 34 | 35 | bg-process: %services/task-master/task-handler.r 36 | pool-list: make block! 16 37 | obj: len: none 38 | queue: make block! 100 39 | worker-args: none 40 | 41 | share [ 42 | pool-start: 2 ; number of helper process when Uniserve starts 43 | pool-max: 4 ; maximum number of helper process 44 | pool-count: 0 ; read-only - ** do not change it **!! 45 | job-max: 100 ; max size of the waiting jobs queue 46 | resurrect?: yes ; create a new process when one die 47 | do-task: func [data service /save locals][ 48 | process-task data service service/client any [locals none] 49 | ] 50 | ] 51 | 52 | task: context [ 53 | busy: no 54 | kill?: no 55 | ctx: none 56 | ] 57 | 58 | fork: has [cmd][ 59 | if verbose > 0 [log/info "launching new slave"] 60 | shared/pool-count: shared/pool-count + 1 61 | cmd: mold either value? 'uniserve-path [ 62 | rejoin [uniserve-path slash bg-process] 63 | ][ 64 | bg-process 65 | ] 66 | launch* either encap? [worker-args][reform [cmd worker-args]] 67 | ] 68 | 69 | send-job: func [port data][ 70 | len: debase/base to-hex length? data: mold data 16 71 | insert data len 72 | write-client/with data port 73 | ] 74 | 75 | process-task: func [data server port locals /local wud obj][ 76 | foreach worker pool-list [ 77 | wud: worker/user-data 78 | if not wud/busy [ 79 | if verbose > 0 [ 80 | log/info join "new task affected using module: " server/module 81 | ] 82 | send-job worker reduce [server/name server/module data] 83 | wud/busy: yes 84 | wud/ctx: reduce [server port locals] 85 | return wud 86 | ] 87 | ] 88 | ;-- Available worker not found, create a new one if allowed 89 | if any [ 90 | zero? shared/pool-max 91 | shared/pool-max > shared/pool-count 92 | ][fork] 93 | 94 | ;-- Queue job until a free worker picks it 95 | either shared/job-max > length? queue [ 96 | if verbose > 0 [log/info "queuing job"] 97 | repend/only queue [copy/deep data server port locals server/module] 98 | ][ 99 | if in obj: client/user-data/ctx/1 'on-task-failed [ 100 | obj/on-task-failed 'overload "maximum workers number reached" 101 | ] 102 | ] 103 | ] 104 | 105 | on-reset: does [ 106 | if verbose > 0 [log/info "resetting all workers"] 107 | foreach worker copy pool-list [ ;-- list copied because it is modified by 'close-peer 108 | either worker/user-data/busy [ 109 | worker/user-data/kill?: yes 110 | ][ 111 | ;close-peer/force/with worker 112 | uniserve/close-connection/bypass worker 113 | remove find pool-list worker 114 | shared/pool-count: shared/pool-count - 1 115 | ] 116 | ] 117 | if integer? shared/pool-start [loop shared/pool-start [fork]] 118 | ] 119 | 120 | on-started: has [file ports][ 121 | worker-args: reform [ 122 | "-worker" mold any [ 123 | all [ports: in uniserve/shared 'server-ports get ports] ;TBD: fix shared object issues 124 | port-id 125 | ] 126 | ] 127 | if not encap? [ 128 | append worker-args reform [" -up" mold uniserve-path] 129 | if value? 'modules-path [ 130 | append worker-args reform [" -mp" mold modules-path] 131 | ] 132 | if all [ 133 | uniserve/shared 134 | file: in uniserve/shared 'conf-file 135 | file: get file 136 | ][ 137 | append worker-args reform [" -cf" mold file] 138 | ] 139 | ] 140 | if integer? shared/pool-start [loop shared/pool-start [fork]] 141 | ] 142 | 143 | on-new-client: has [job][ 144 | if client/remote-ip <> 127.0.0.1 [close-client exit] 145 | set-modes client [keep-alive: on] 146 | client/timeout: 15 147 | client/user-data: make task [] 148 | append pool-list :client 149 | stop-at: 4 150 | if verbose > 0 [log/info "new slave process connected"] 151 | if not empty? queue [ 152 | job: queue/1 153 | send-job client reduce [job/2/name job/5 job/1] 154 | client/user-data/busy: yes 155 | client/user-data/ctx: reduce [job/2 job/3 job/4] 156 | remove queue 157 | if verbose > 0 [log/info "new slave got job"] 158 | ] 159 | ] 160 | 161 | on-close-client: has [ctx svc sav-client][ 162 | remove find pool-list :client 163 | shared/pool-count: shared/pool-count - 1 164 | if client/user-data/busy [ 165 | if in obj: client/user-data/ctx/1 'on-task-failed [ 166 | ctx: client/user-data/ctx 167 | svc: ctx/1 168 | sav-client: svc/client 169 | svc/client: svc/peer: ctx/2 ; restore client port 170 | obj/on-task-failed 'error ctx/3 171 | svc/client: svc/peer: sav-client 172 | ] 173 | ] 174 | if verbose > 0 [log/info "slave process closed"] 175 | 176 | if all [ 177 | not zero? shared/pool-max 178 | shared/resurrect? 179 | shared/pool-max > shared/pool-count 180 | ][fork] 181 | ] 182 | 183 | 184 | on-received: func [data /local job svc sav-client locals][ 185 | either stop-at = 4 [ 186 | if verbose > 1 [log/info "header received"] 187 | stop-at: to integer! copy data 188 | ][ 189 | if verbose > 1 [log/info "body received"] 190 | ctx: client/user-data/ctx 191 | svc: ctx/1 192 | sav-client: svc/client 193 | svc/client: svc/peer: ctx/2 ; restore client port 194 | locals: ctx/3 195 | data: first load/all as-string data 196 | switch first data [ 197 | ok [svc/on-task-done data/2 locals] 198 | part [ 199 | if in svc 'on-task-part [svc/on-task-part data/2 locals] 200 | svc/client: svc/peer: sav-client 201 | stop-at: 4 202 | exit 203 | ] 204 | error [ 205 | if in svc 'on-task-failed [ 206 | svc/on-task-failed first reduce next data locals 207 | ] 208 | ] 209 | ] 210 | stop-at: 4 211 | if client/user-data/kill? [ 212 | close-client 213 | exit 214 | ] 215 | svc/client: svc/peer: sav-client 216 | either empty? queue [ 217 | client/user-data/busy: no 218 | client/user-data/ctx: none 219 | if zero? shared/pool-max [close-client] 220 | ][ 221 | job: queue/1 222 | send-job client reduce [job/2/name job/5 job/1] 223 | client/user-data/ctx: reduce [job/2 job/3 job/4] 224 | remove queue 225 | if verbose > 0 [log/info "no wait-state slave reuse"] 226 | ] 227 | ] 228 | ] 229 | ] -------------------------------------------------------------------------------- /UniServe/services/task-master/task-handler.r: -------------------------------------------------------------------------------- 1 | REBOL [ 2 | Title: "Uniserve: task-master client" 3 | Author: "SOFTINNOV / Nenad Rakocevic" 4 | Version: 1.2.0 5 | Date: 31/12/2008 6 | ] 7 | 8 | logger: context [ 9 | server: make system/standard/port [ 10 | scheme: 'tcp 11 | port-id: 9802 12 | host: 127.0.0.1 13 | ] 14 | col: #":" 15 | zero: #"0" 16 | dot: #"." 17 | excl: #"!" 18 | dash: #"-" 19 | 20 | emit: func [data err? /local h time off][ 21 | time: mold now/time/precise 22 | off: pick [-3 -6] system/version/4 = 3 23 | if col = time/2 [insert time zero] 24 | if dot = pick tail time off [insert tail time zero] 25 | unless find time dot [ 26 | insert tail time pick [".000" ".000000"] system/version/4 = 3 27 | ] 28 | data: rejoin [now/day slash now/month dash time dash data newline] 29 | h: debase/base to-hex length? data 16 30 | insert tail h #"T" ;pick [#"E" #"T"] to logic! err? 31 | insert data h 32 | attempt [write/direct/no-wait/binary server data] 33 | ] 34 | 35 | notify: func [msg module [word!] type [word!] /local out][ 36 | out: either block? msg [rejoin msg][copy msg] 37 | unless string? out [out: mold out] 38 | uppercase/part out 1 39 | out: reform switch type [ 40 | warn [["# Warning in" mold reduce [module] col out excl]] 41 | error [["## Error in" mold reduce [module] col out excl]] 42 | fatal [["### FATAL in" mold reduce [module] col out excl]] 43 | info [[mold reduce [module] out]] 44 | ] 45 | emit out type <> 'info 46 | ] 47 | ] 48 | 49 | log-class: context [ 50 | name: 'log-class 51 | 52 | log: func [[throw] msg /warn /error /info /fatal][ 53 | case [ 54 | info [logger/notify msg name 'info] 55 | warn [logger/notify msg name 'warn] 56 | error [logger/notify msg name 'error] 57 | fatal [logger/notify msg name 'fatal] 58 | ] 59 | ] 60 | ] 61 | 62 | debug: context [ 63 | server: none ;-- reserved for remote console future use 64 | 65 | emit-dbg: func [msg][logger/emit join "[DEBUG] " msg false] 66 | 67 | set '? print: func [msg][emit-dbg msg :msg] 68 | 69 | probe: func [msg][emit-dbg mold :msg :msg] 70 | 71 | set '?? func ['name][ 72 | emit-dbg either word? :name [ 73 | head insert tail form name reduce [": " mold name: get name] 74 | ][ 75 | mold :name 76 | ] false 77 | ] 78 | 79 | trace: func [n [integer!]][ 80 | ;-- TBD 81 | ] 82 | ] 83 | 84 | protect [logger log-class debug] 85 | 86 | if ssa: system/script/args [ 87 | ssa: load/all ssa 88 | if value: select ssa '-up [uniserve-path: value] 89 | if value: select ssa '-mp [modules-path: value] 90 | if value: select ssa '-cf [config-path: value] 91 | servers-port: select ssa '-worker 92 | 93 | either block? servers-port [ 94 | uniserve-port: servers-port/task-master 95 | logger/server/port-id: servers-port/logger 96 | ][ 97 | uniserve-port: servers-port 98 | ] 99 | ] 100 | unless any [value? 'uniserve-path all [value? 'encap? encap?]][uniserve-path: what-dir] 101 | unless value? 'modules-path [modules-path: dirize uniserve-path/modules] 102 | 103 | change-dir system/options/path 104 | 105 | unless value? 'encap-fs [ 106 | do uniserve-path/libs/encap-fs.r 107 | change-dir system/options/path 108 | ] 109 | 110 | s-read-io: get in system/words 'read-io 111 | s-quit: get in system/words 'quit 112 | s-halt: get in system/words 'halt 113 | 114 | ctx-task-class: make log-class [ 115 | name: 'task-handler 116 | verbose: 0 117 | 118 | module: server: scheme: state: err: req: t0: len: remains: none 119 | packet: make binary! buf-size: 1024 * 16 120 | request: make binary! buf-size 121 | 122 | server-address: 127.0.0.1 123 | server-port: uniserve-port 124 | 125 | modules: make block! 5 126 | 127 | set 'install-module func [body [block!]][ 128 | module: make make log-class [on-task-received: result: none] body 129 | if verbose > 0 [log/info ["installing module : " mold module/name]] 130 | repend modules [module/name module] 131 | recycle 132 | ] 133 | 134 | set 'server-send-data func [data][ 135 | insert data debase/base to-hex length? data 16 136 | insert server data 137 | ] 138 | 139 | connect: does [ 140 | server: open/binary/direct rejoin [tcp:// server-address ":" server-port] 141 | set-modes server [keep-alive: on] 142 | wait [server 0] ; fix for first packet read error rare case (state = -4) 143 | 144 | name: to-word rejoin [mold name #"-" form server/local-port] 145 | if verbose > 0 [log/info "connected to Uniserve"] 146 | 147 | forever [ 148 | clear request 149 | clear packet 150 | if verbose > 0 [log/info "waiting for task..."] 151 | wait server 152 | state: s-read-io server packet 4 153 | case [ 154 | state <= 0 [ 155 | if state < -1 [ 156 | log/error join "quit - cause: server read state is " state 157 | ] 158 | attempt [close server] 159 | s-quit 160 | ] 161 | state = 4 [ 162 | remains: len: to integer! packet 163 | ] 164 | state < 4 [ 165 | len: to integer! copy/part packet 4 166 | remains: len - length? packet: at packet 5 167 | insert tail request packet 168 | ] 169 | ] 170 | if verbose > 0 [log/info ["header received, body:" len]] 171 | until [ 172 | clear packet 173 | wait server 174 | state: s-read-io server packet min remains buf-size 175 | if verbose > 1 [log/info ["state:" state]] 176 | if positive? state [ 177 | remains: remains - length? packet 178 | insert tail request packet 179 | ] 180 | any [zero? remains state <= 0] 181 | ] 182 | if verbose > 0 [t0: now/time/precise] 183 | req: load as-string request 184 | either error? set/any 'err try [ 185 | unless find modules req/2 [ 186 | do-cache join modules-path [req/2 %.r] 187 | change-dir system/options/path 188 | ] 189 | module: select modules req/2 190 | module/result: none 191 | module/on-task-received load as-string req/3 192 | false 193 | ][ 194 | err: disarm err 195 | log/error mold err 196 | server-send-data remold ['error mold/all err] 197 | ][ 198 | server-send-data remold ['ok module/result] 199 | if verbose > 0 [log/info ["done in " now/time/precise - t0 " sec"]] 200 | ] 201 | ] 202 | ] 203 | ] 204 | 205 | if error? set/any 'err try [ 206 | unless encap-fs/cache [ctx-task-class/connect] 207 | ][ 208 | attempt [close ctx-task-class/server] 209 | change-dir system/options/path 210 | write/append %worker-crash.log reform [newline now ":" mold disarm :err] 211 | ] 212 | --------------------------------------------------------------------------------