[BACK]Return to httpd.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Doc

Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.21

1.21    ! takayama    1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.20 2010/02/08 01:08:39 takayama Exp $
1.1       takayama    2: %% common modules for httpd on sm1.
1.18      takayama    3: % [(Strict) 1] system_variable  % for debugging.
1.2       takayama    4: /Oxserver_history_variable (Oxserver_history_variable_) def
1.4       takayama    5: /httpd.image.type
                      6:   [(getenv) (OpenXM_PSTOIMG_TYPE)] extension
                      7: def
                      8:
1.19      takayama    9: /httpd_sm1.cookie
                     10:  [(oxGenPass)] extension
                     11: def
                     12: /httpd.set-cookie {
                     13:   [(Set-Cookie: httpd_sm1=) httpd_sm1.cookie] cat
                     14: } def
                     15:
                     16:
1.12      takayama   17: [(getenv) (OXWEB_DEBUG)] extension tag 0 eq {
                     18:    /httpd.debug 0 def
                     19: } {
                     20:    /httpd.debug 1 def
                     21: } ifelse
                     22: [(getenv) (OXWEB_TAKE_LOG)] extension tag 0 eq {
                     23:    /httpd.take.log  0 def
                     24: } {
                     25:    /httpd.take.log 1 def
                     26: } ifelse
                     27:
1.2       takayama   28:
1.1       takayama   29: /httpd_startserver {
                     30:    [(sm1.socket) (open) [httpd.port (localhost)]] extension
                     31:    /httpd.server.fdAndPort set
                     32:    (sm1.socket.open returns  ) messagen httpd.server.fdAndPort message
                     33:    [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
                     34:    /httpd.server.fd set
                     35:    (connected.) message
                     36:    (sm1.socket.accept returns  ) messagen httpd.server.fd message
                     37: } def
                     38:
                     39: /httpd_stopserver {
                     40:    [(sm1.socket) (close) httpd.server.fd ] extension message
                     41: } def
                     42:
                     43: /send_packet {
                     44:   /arg1 set
                     45:   [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
                     46: } def
                     47:
                     48: /sendln {
                     49:  /arg1 set
1.12      takayama   50:  [/in-sendln /mmm /i] pushVariables
1.1       takayama   51:  [ arg1 /mmm set
                     52:   mmm tag 5 eq {
                     53:     [mmm 10 (string) dc] cat /mmm set
                     54:   }{
                     55:     10 (string) dc /mmm set
                     56:   } ifelse
                     57:   [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
                     58:     (Warning (sendln): your peer closed the connection. Do not send the data.) message
                     59:   } {
1.12      takayama   60:     [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension /i set
                     61:      httpd.debug { i message } { } ifelse
1.1       takayama   62:   } ifelse
                     63:  ] pop
                     64:  popVariables
                     65: } def
                     66:
                     67: /sendBinaryFile {
                     68:  /arg1 set
                     69:  [/in-sendln /fname /fd /c /cdata] pushVariables
                     70:  [ arg1 /fname set
                     71:    [(sendBinaryFile: sending data) ] cat message
                     72:    [(fp2openForRead) fname] extension /fd set  fd message
                     73:    fd 0 lt {
                     74:       [(Error: sendBinaryFile: file ) fname ( is not found.)] cat message
                     75:       /aaaa goto
                     76:    } {  } ifelse
                     77:    [(fp2pushfile) fname] extension /cdata set
                     78:    [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
                     79:        (Warning (sendBinaryFile): your peer closed the connection. Do not send the data.)
                     80:        message
                     81:        exit
                     82:    } {
                     83:        [(sm1.socket) (writeByte) [httpd.server.fd 0 get cdata]] extension pop
                     84:    } ifelse
                     85:    /aaaa
                     86:  ] pop
                     87:  popVariables
                     88: } def
                     89:
                     90: /httpd {
                     91:   /httpd.serial 0 def
                     92:   /httpd.history [ ] def
                     93:   /httpd.result.history [ 0 ] def
1.15      takayama   94:   [(nobody)] extension pop
1.1       takayama   95:   {
                     96:     httpd_startserver ;
                     97:     httpd_action ;
                     98:     httpd_stopserver ;
1.12      takayama   99:     httpd.take.log { (date) system  } { } ifelse
1.6       takayama  100: %    (sleep 2) system
1.1       takayama  101:     httpd.serial 1 add /httpd.serial set
                    102:   } loop
                    103: } def
                    104:
                    105: /send-page-bye {
                    106:    (HTTP/0.9 200 OK) sendln
                    107: %%   (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
                    108: %%   (Server: sm1/0.1 (Unix)) sendln
                    109: %%   (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
                    110: %%   (ETag: "1f8f-5df-39a3b33f") sendln
                    111: %%   (Accept-Ranges: bytes) sendln
                    112: %%   (Content-Length: 10) sendln
                    113:    (Connection: close) sendln
                    114: %   (Content-Type: text/plain) sendln
                    115:    (Content-Type: text/html) sendln
                    116:    0 sendln
                    117:    (<html>) sendln
                    118:    (Shutdown the engine. <br>) sendln
1.6       takayama  119:    (See you! <a href="http://www.openxm.org"> Web/asir, Web/sm1 </a>) sendln
1.1       takayama  120:    (</html>) sendln
                    121:    0 sendln
                    122:    [(flush)] extension
                    123: } def
                    124:
                    125: /send-page-2 {
                    126:    (HTTP/0.9 200 OK) sendln
                    127: %%   (Content-Length: 10) sendln
                    128:    (Connection: close) sendln
                    129:    (Content-Type: text/html) sendln
                    130:    0 sendln
                    131:    (<FORM NAME="myFORM">) sendln
                    132:    (<INPUT TYPE="TEXT" NAME="Num">) sendln
                    133:    (</FORM>) sendln
                    134:    0 sendln
                    135:    [(flush)] extension
                    136: } def
                    137:
                    138: /send-page-3 {
                    139:   /arg1 set
                    140:   [/in-send-page-3 /result] pushVariables
                    141:   [
                    142:    /result arg1 def
                    143:    (HTTP/0.9 200 OK) sendln
                    144:    (Connection: close) sendln
                    145:    (Content-Type: text/html) sendln
1.19      takayama  146:    httpd.set-cookie sendln
1.1       takayama  147:    0 sendln
                    148: %%   (<FORM NAME="myFORM" METHOD="POST">) sendln
                    149:    result sendln
                    150:
                    151:    %%(<img src="hoge.jpeg"> <img>) sendln %%test.  It does not work always?!
                    152:    %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
                    153:
1.7       takayama  154:   [(getenv) (OXWEB_POST)] extension tag 0 eq {
                    155:     (<FORM NAME="myFORM">) sendln  % use get
                    156:   }{
                    157:     (<FORM NAME="myFORM" METHOD="POST">) sendln
                    158:   } ifelse
1.1       takayama  159:    (<INPUT TYPE=submit VALUE="submit">) sendln
                    160:    [(<textarea name=) httpd.textarea.name
                    161:     ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
                    162:    (</FORM>) sendln
                    163:    send-menu-1
                    164:    0 sendln
                    165:    [(flush)] extension
                    166:   ] pop
                    167:   popVariables
                    168: } def
                    169:
                    170: /send-image {
                    171:   /arg2 set
                    172:   /arg1 set
                    173:   [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
                    174:   [
                    175:      /fname arg1 def % set the jpeg file name.
                    176:      /imagetype arg2 def %  jpeg or gif
                    177:     [(stat) fname] extension 0 get tag 0 eq {
                    178:        (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
                    179:        /notFound goto
                    180:     }{  }ifelse
                    181:     [(stat) fname] extension 1 get 0 get toString /fsize set
                    182:     (HTTP/1.1 200 OK) dup message sendln
                    183:     (Server: httpd_sm1) dup message sendln
                    184:     %% (ETag: "2197-bf6c-3b2d6541") sendln ???
                    185:     (Accept-Ranges: bytes) dup message sendln
                    186:     [(Content-Length: ) fsize] cat dup message sendln
                    187:     (Connection: close) dup message sendln
                    188:     [(Content-Type: image/) imagetype] cat dup message sendln
                    189:     [(flush)] extension
                    190:     0 sendln
                    191:     fname sendBinaryFile
                    192:     0 sendln
                    193:     [(flush)] extension
                    194:     /notFound
                    195:   ] pop
                    196:   popVariables
                    197: } def
                    198:
                    199: /send-page-warning {
                    200:    (HTTP/0.9 200 OK) sendln
                    201:    (Connection: close) sendln
                    202:    (Content-Type: text/html) sendln
                    203:    0 sendln
                    204:    (You cannot execute ox servers without a session key! <br>) sendln
1.5       takayama  205:    0 sendln
                    206:    [(flush)] extension
                    207: } def
                    208:
                    209: /send-page-warning-image {
                    210:    (HTTP/0.9 200 OK) sendln
                    211:    (Connection: close) sendln
                    212:    (Content-Type: text/html) sendln
                    213:    0 sendln
                    214:    (Error: Image translation is not supported on this server<br>) sendln
                    215:    (  Check the value of the environmental variable OpenXM_PSTOIMG_TYPE <br>) sendln
1.1       takayama  216:    0 sendln
                    217:    [(flush)] extension
                    218: } def
                    219:
                    220: /stopclient {
                    221:   [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
                    222: } def
                    223:
                    224:
                    225: /cleanErrors {
                    226:   /arg1 set
                    227:   [/in-cleanErrors /clientt /spp] pushVariables
                    228:   [
                    229:     /clientt arg1 def
                    230:     clientt oxgetsp (integer) dc /spp set
                    231:     clientt spp oxpops
                    232:   ] pop
                    233:   popVariables
                    234: } def
                    235:
                    236:
                    237: /fromHex {
                    238:   /arg1 set
                    239:   [/in-fromHex /s1 /s2 /c /c2] pushVariables
                    240:   [
                    241:     arg1 0 get /s1 set
                    242:     arg1 1 get /s2 set
                    243:
                    244:     48 s1 le  s1 57 le and {  % 0, ..., 9
                    245:       s1 48 sub /c set
                    246:     }{ } ifelse
                    247:     65 s1 le  s1 70 le and {  % A, ..., F
                    248:       s1 65 sub 10 add /c set
                    249:     }{ } ifelse
                    250:     97 s1 le  s1 102 le and {  % a, ..., f
                    251:       s1 97 sub 10 add /c set
                    252:     }{ } ifelse
                    253:     c 16 mul /c set
                    254:
                    255:     48 s2 le  s2 57 le and {  % 0, ..., 9
                    256:       s2 48 sub /c2 set
                    257:     }{ } ifelse
                    258:     65 s2 le  s2 70 le and {  % A, ..., F
                    259:       s2 65 sub 10 add /c2 set
                    260:     }{ } ifelse
                    261:     97 s2 le  s2 102 le and {  % a, ..., f
                    262:       s2 97 sub 10 add /c2 set
                    263:     }{ } ifelse
                    264:     c c2 add /arg1 set
                    265:   ] pop
                    266:   popVariables
                    267:   arg1
                    268: } def
                    269:
                    270: /randomName {
                    271:   [/in-randomName /sss /rrr ] pushVariables
                    272:   [
                    273:     %% Seed name
                    274:     /sss [ 97 97 97 97 97 97 97 97 97 97 ] def  %% 97 == 'a'
                    275:     %% This procedure to generate port number might fail.
                    276:     sss {
                    277:       [
                    278:         [(oxGenPass)] extension .. /rrr set
                    279:         [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
                    280:       ] pop
                    281:       rrr (integer) dc add
                    282:     } map
                    283:     /sss set
                    284:     sss {(string) dc} map cat /arg1 set
                    285:   ] pop
                    286:   popVariables
                    287:   arg1
                    288: } def
                    289:
                    290: (httpd.textarea.name) boundp { }
                    291:  {
                    292:     /httpd.textarea.name  randomName def
                    293:     /httpd.textarea.name.aaa
                    294:        [(GET /?) httpd.textarea.name] cat
                    295:        (array) dc
                    296:     def
                    297:  } ifelse
                    298:
                    299:
                    300:
                    301: /askToSendFile {
                    302:   /arg1 set
                    303:   [/in-askToSendFile /ss /fname] pushVariables
                    304:   [
                    305:     /ss arg1 def
                    306:     /fname null def
                    307:     ss toTokensBySpace /ss set
                    308:     ss 0 get (GET) eq {
                    309:       ss 1 get length 1 gt {
                    310:         ss 1 get (array) dc 1 get 63 eq { %% See if /?
                    311:           /fname null def
                    312:         }{
                    313:           /fname ss 1 get def % set the file name.
                    314:           fname (array) dc rest /fname set % remove /
                    315:           fname { (string) dc } map cat /fname set
                    316:         } ifelse
                    317:       }{ /fname null def } ifelse
                    318:     }{
                    319:       /fname null def
                    320:     } ifelse
                    321:     (::::) messagen  ss message fname message
                    322:     /arg1 fname def
                    323:   ] pop
                    324:   popVariables
                    325:   arg1
                    326: } def
                    327:
1.8       takayama  328: %% remove GET /?msg= or msg=
1.1       takayama  329: /removeGET {
                    330:   /arg1 set
                    331:   [/in-removeGET /s /s2 /i /j /i0
1.11      takayama  332:    /tname  /nnn /sta
1.1       takayama  333:   ] pushVariables
                    334:   [
                    335:      /s arg1 def
1.10      takayama  336:      /httpd.textarea.valid 0 def
1.1       takayama  337:      s 1 copy /s2 set
                    338:      s (array) dc /s set
1.11      takayama  339:
                    340:      /sta 0 def
                    341:
                    342:      %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
                    343:      s length 4 gt {
                    344:        [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
                    345:           0 1 s length 4 sub {
                    346:              /i0 set
                    347:              /sta i0 def
                    348:              [ s i0 get  s i0 1 add get ] [ 10 10 ] eq
                    349:              [ s i0 get  s i0 1 add get s i0 2 add get s i0 3 add get]
                    350:              [ 13 10 13 10] eq or
                    351:              { exit } { } ifelse
                    352:           } for
                    353:         }{ } ifelse
                    354:      } { } ifelse
                    355:      (sta=) messagen sta message
1.7       takayama  356:      /nnn httpd.textarea.name.aaa length 6 sub def
1.1       takayama  357:
                    358:      /tname  [  ] def
1.11      takayama  359:      sta 1 s length 1 sub {
1.1       takayama  360:        /i0 set
                    361:        s i0 get 61 eq {  %% 61 is =
                    362:          i0 1 add /i0 set
1.7       takayama  363:
                    364:          [
                    365:           << tname length 1 sub  >> -1
1.9       takayama  366:           << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse
                    367:           {
1.7       takayama  368:              /i set
                    369:              tname i get
                    370:           } for
1.9       takayama  371:          ] reverse /tname set
1.7       takayama  372:          (GET /?) (array) dc tname join /tname set
                    373:
1.12      takayama  374:          httpd.debug { httpd.textarea.name.aaa message } {  } ifelse
1.1       takayama  375:          tname httpd.textarea.name.aaa eq {
                    376:            /httpd.textarea.valid 1 def
                    377:          } {
                    378:            /httpd.textarea.valid 0 def
1.12      takayama  379:            tname message
1.7       takayama  380:            httpd.textarea.name.aaa { (string) dc } map cat message
1.1       takayama  381:            (Warning: got an invalid name for the text field.) message
                    382:          } ifelse
                    383:          exit
                    384:        } { } ifelse
                    385:        tname s i0 get append /tname set
                    386:      } for
                    387:
                    388:      /j 0 def
                    389:      i0 1 s length 1 sub {
                    390:        /i set
                    391:        s2 j << s i get (string) dc >> put
1.8       takayama  392:        j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
                    393:        %% might cause a BUG. It should be improved.
1.1       takayama  394:        j 1 add /j set
                    395:      } for
                    396:      /arg1 s2 def
                    397:   ] pop
                    398:   arg1
                    399: } def
                    400:
                    401: /webstringToAscii {
                    402:   /arg1 set
                    403:   [/in-webstringToAscii /s /i /j /c /n] pushVariables
                    404:   [
                    405:      /s arg1 def
                    406:      s (array) dc /s set
                    407:      /j 0 def /n s length def
                    408:      /i 0 def
                    409:      {
                    410:        s i get /c set
                    411:        c 32 eq { exit } { } ifelse
                    412:        c 37 eq {  % c == %
                    413:          [s i 1 add get s i 2 add get] fromHex /c set
                    414:          s j c put
                    415:          j 1 add /j set
                    416:          i 3 add /i set
                    417:        } {
                    418:          c 43 eq { % c == +
                    419:            s j 32 put
                    420:            j 1 add /j set
                    421:            i 1 add /i set
                    422:           } {
                    423:             c 13 eq { % c == 0xd
                    424:               i 1 add /i set
                    425:             } {
                    426:               s j c put
                    427:               j 1 add /j set
                    428:               i 1 add /i set
                    429:             } ifelse
                    430:          } ifelse
                    431:        } ifelse
                    432:        i n ge { exit } {  } ifelse
                    433:      } loop
                    434:      s j carN /s set
                    435:      s { (string) dc } map cat /arg1 set
                    436:   ] pop
                    437:   popVariables
                    438:   arg1
                    439: } def
                    440:
                    441: /preformatHTML {
                    442:   /arg1 set
                    443:   [/in-preformatHTML /sss /c] pushVariables
                    444:   [
                    445:      /sss arg1 def
1.17      takayama  446:      sss toString /sss set
1.1       takayama  447:      sss (array) dc /sss set
                    448:      sss {
                    449:        /c set
                    450:        [
                    451:           c 60 eq {
                    452:             /c (&lt) def
                    453:           } {  } ifelse
                    454:           c 62 eq {
                    455:             /c (&gt) def
                    456:           } {  } ifelse
                    457:           c 38 eq {
                    458:             /c (&amp) def
                    459:           } {  } ifelse
                    460:         ] pop
                    461:         c (string) dc
                    462:      } map cat /sss set
                    463:      [(<pre> ) sss ( </pre> )] cat /arg1 set
                    464:   ] pop
                    465:   popVariables
                    466:   arg1
                    467: } def
1.2       takayama  468:
1.3       takayama  469: /executeStringAndSelectInputFromBrowserAndOxserver {
                    470:   /arg3 set
1.2       takayama  471:   /arg2 set
                    472:   /arg1 set
1.3       takayama  473:   [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2       takayama  474:     /oxserver.ccc
                    475:     /command.to.oxserver
                    476:     /sss.engine
                    477:     /sss.web
                    478:     /sss
                    479:     /err
                    480:     /httpd.result
1.3       takayama  481:     /stringOrCmo
1.2       takayama  482:   ] pushVariables
                    483: % Global var: httpd.server.fd
                    484:   [
                    485:      /oxserver.ccc arg1 def
                    486:      /command.to.oxserver arg2 def
1.3       takayama  487:      /stringOrCmo arg3 def
1.2       takayama  488:             oxserver.ccc
                    489:             command.to.oxserver
                    490:             oxexecutestring ;
                    491:
                    492:             [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
                    493:
                    494:             [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3       takayama  495:             stringOrCmo (string) eq {
                    496:               [(oxReq) oxserver.ccc SM_popString ] extension pop
                    497:             }{
                    498:               [(oxReq) oxserver.ccc SM_popCMO ] extension pop
                    499:             } ifelse
1.2       takayama  500:             [(flush)] extension pop
                    501:             %% Select inputs for interruption.
                    502:             %% Wait by the spin lock.
                    503:             {
                    504:               [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
                    505:               /sss.engine set
                    506:               [(sm1.socket) (mselect)
                    507:                 [[httpd.server.fd 0 get] 1]
                    508:               ] extension 0 get /sss.web set
                    509:               /sss [sss.engine sss.web] def
                    510:               sss.engine { exit } { } ifelse
                    511:               sss.web    { exit } { } ifelse
                    512:             } loop
                    513:             sss message
                    514:
                    515:             sss 0 get {
                    516:                 [(oxGet) oxserver.ccc] extension  /err          set
                    517:                 [(oxGet) oxserver.ccc] extension  /httpd.result set
                    518:             } {
                    519:                 oxserver.ccc oxreset
                    520:                 oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
                    521:                 oxserver.ccc oxpopstring
                    522:                 /httpd.result set
                    523:                 exit
                    524:             } ifelse
                    525:             (------------- result -------------) message
                    526:             httpd.result message
                    527:             (----------------------------------) message
                    528:             (  ) message
                    529:
                    530:             err message
                    531:             err [ ] eq  {
                    532:             } {
                    533:               oxserver.ccc cleanErrors
                    534:               [httpd.result 10 (string) dc err toString] cat
                    535:               /httpd.result set
                    536:             } ifelse
                    537:            /arg1 [err httpd.result] def
                    538:    ] pop
                    539:    popVariables
                    540:    arg1
1.13      takayama  541: } def
                    542:
                    543: % This function will be written in C in a future.
                    544: % [(httpd) (parseHTTP) string] extension
                    545: % [(GET) key-value-pair-1 key-value-pair-2 ...]
                    546: % [(POST) key-value-pair-1 key-value-pair-2 ...]
                    547: % [(GET-file) file-1 file2 ...]
                    548: % ex. (GET / HTT..) (GET /?rpc=1-2)
                    549: /httpd.parse {
                    550:  /arg1 set
                    551:  [/in-httpd.parse /s /s2 /sta /i0
                    552:   /ans /getKeyword /j /tname /tvalue
                    553:  ] pushVariables
                    554:  [
                    555:      /s arg1 def
                    556:      s 1 copy /s2 set
                    557:      s (array) dc /s set
                    558:
                    559:      /sta 0 def
                    560:      /getKeyword 0 def
                    561:
                    562:      s length 7 lt {
                    563:         /ans [(GET-file)] def
                    564:         /httpd.exit goto
                    565:      }{ } ifelse
                    566:
                    567:      /ans [(GET)] def
                    568:      [s 0 get s 1 get s 2 get s 3 get s 4 get s 5 get] (GET /?) (array) dc eq {
                    569:         /sta 6 def
                    570:         /getKeyword 1 def
                    571:      }{
                    572:         [s 0 get s 1 get s 2 get s 3 get s 4 get] (GET /) (array) dc eq {
                    573:             /sta 5 def
                    574:         }{
                    575:           [s 0 get s 1 get s 2 get s 3 get] (GET ) (array) dc eq {
                    576:              /ans [(GET-file)] def
                    577:              /httpd.exit goto
                    578:           }  { /ans [ ] def /httpd.exit.goto } ifelse
                    579:         } ifelse
                    580:      }ifelse
                    581:
                    582:      %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
                    583:      [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
                    584:           /ans [(POST) ] def
                    585:           /getKeyword  1 def
                    586:           0 1 s length 4 sub {
                    587:              /i0 set
                    588:              /sta i0 def
                    589:              [ s i0 get  s i0 1 add get ] [ 10 10 ] eq
                    590:              [ s i0 get  s i0 1 add get s i0 2 add get s i0 3 add get]
                    591:              [ 13 10 13 10] eq or
                    592:              { exit } { } ifelse
                    593:           } for
                    594:      }{ } ifelse
                    595:      (sta=) messagen sta message
                    596:
                    597:      %% get file name
                    598:      getKeyword not {
                    599:        /tname  [  ] def
                    600:        sta 1 << s length 1 sub >> {
                    601:          /i0 set
                    602:          s i0 get 32 le {  %% 32 is  " "
                    603:            exit
                    604:          } { } ifelse
                    605:          tname s i0 get append /tname set
                    606:        } for
                    607:        httpd.debug { (Filename is ) messagen tname {(string) dc } map message} {  } ifelse
                    608:        /ans [(GET-file) tname { (string) dc } map cat ] def
                    609:        /httpd.exit goto
                    610:      } { } ifelse
                    611:
                    612:      /tname  [  ] def
                    613:      sta 1 << s length 1 sub >> {
                    614:        /i0 set
                    615:        s i0 get 61 eq {  %% 61 is =
                    616:          httpd.debug { tname message tname {(string) dc } map cat message} {  } ifelse
                    617:          i0 1 add /i0 set
                    618:          exit
                    619:        } { } ifelse
                    620:        tname s i0 get append /tname set
                    621:      } for
                    622:
1.15      takayama  623:      %% Remove space and cr/lf from the key word.
                    624:      [
                    625:        0 1 tname length 1 sub {
                    626:          /j set
                    627:          tname j get 36 le {
                    628:          } {
                    629:            tname j get
                    630:          } ifelse
                    631:       } for
                    632:      ] /tname set
                    633:
1.13      takayama  634:      /j 0 def
                    635:      i0 1 s length 1 sub {
                    636:        /i set
                    637:        s2 j << s i get (string) dc >> put
                    638:        j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
                    639:        %% might cause a BUG. It should be improved.
                    640:        j 1 add /j set
                    641:      } for
                    642:      ans [tname {(string) dc} map  cat
                    643:            s2 webstringToAscii ] append
                    644:      /ans set
                    645:
                    646:      /httpd.exit
1.14      takayama  647:      ans length 1 lt {
                    648:        /ans [(Unknown)] def
                    649:      } {  } ifelse
1.13      takayama  650:      /arg1 ans def
                    651:  ] pop
                    652:  popVariables
                    653:  arg1
1.14      takayama  654: } def
                    655:
                    656: /httpd.root [(getenv) (OXWEB_HTTPD_ROOT)] extension def
                    657: %% /usr/local/www/data/   Assume slash!!
                    658:
                    659: % [(GET-file) (filename)] httpd_sendfile
                    660: % [(MSG) (message)]       httpd_sendfile
                    661: /httpd_sendfile {
                    662:   /arg1 set
                    663:   [/in-htpd_sendfile /msg /fname /fname2
                    664:    /fsize
                    665:   ] pushVariables
                    666:   [
                    667:      /msg arg1 def
                    668:      %% Send message.  [(MSG) msg2 ...] httpd_sendfile
                    669:      msg message
                    670:      msg 0 get (MSG) eq {
                    671:        (HTTP/0.9 200 OK) sendln
                    672:        (Connection: close) sendln
                    673:        (Content-Type: text/html) sendln
                    674:        0 sendln
                    675:        msg rest { sendln } map
                    676:        0 sendln
                    677:        [(flush)] extension
                    678:        /httpd_sendfile.L1 goto
                    679:      }{ } ifelse
                    680:      %% Get a file message.  [(GET-file) fname] httpd_sendfile
                    681:      msg 0 get (GET-file) eq {
                    682:        httpd.root tag 5 eq not {
                    683:          [(MSG) (<h1> File transfer is not allowed on this server. </h1>)]
                    684:          httpd_sendfile
                    685:          /httpd_sendfile.L1 /httpd_sendfile.L1 goto
                    686:        } {  } ifelse
                    687:        msg length 1 eq {
                    688:            /fname (index.html) def
                    689:        }{
                    690:            /fname msg 1 get def
1.15      takayama  691:            (fname=) messagen fname (array) dc message
1.14      takayama  692:            fname tag 5 eq not {
                    693:              [(MSG) (<h1> Invalid file name. </h1>)]
                    694:              httpd_sendfile
                    695:              /httpd_sendfile.L1 /httpd_sendfile.L1 goto
                    696:            } {  } ifelse
                    697:            fname (array) dc /fname set
                    698:            fname length 1 lt {
1.15      takayama  699:              /fname (index.html) (array) dc def
1.14      takayama  700:            } {  } ifelse
                    701:
                    702:            fname [47] eq {
                    703:               /fname (index.html) (array) dc def
                    704:            }{ } ifelse
                    705:
                    706:            fname 0 get 47 eq {  %% /
                    707:              /fname fname rest def
                    708:            } {  } ifelse
                    709:
                    710:            fname { (string) dc } map cat /fname  set
                    711:        } ifelse
                    712:
                    713:        /fname2 fname def
                    714:        [httpd.root fname2] cat /fname set
                    715:        [(fname=) fname] cat message
1.15      takayama  716:        fname httpd.check_name {
                    717:          [(MSG) (Warning:  invalid file name.)] httpd_sendfile
                    718:          /httpd_sendfile.L1 /httpd_sendfile.L1 goto
                    719:        } {  } ifelse
1.14      takayama  720:        [(stat) fname] extension 0 get tag 0 eq {
                    721:          [(MSG) (Warning (sendfile): the file )  fname2 ( is not found.) ]
                    722:           httpd_sendfile
                    723:          /httpd_sendfile.L1 /httpd_sendfile.L1 goto
                    724:        }{  }ifelse
                    725:        [(stat) fname] extension 1 get 0 get toString /fsize set
                    726:        (HTTP/1.1 200 OK)  sendln
                    727:        (Server: httpd_sm1) sendln
                    728:        %% (ETag: "2197-bf6c-3b2d6541") sendln ???
                    729:        (Accept-Ranges: bytes) sendln
                    730:        [(Content-Length: ) fsize] cat  sendln
                    731:        (Connection: close) sendln
                    732:        [(Content-Type: ) fname httpd_type] cat sendln
                    733:        [(flush)] extension
                    734:        0 sendln
                    735:        fname sendBinaryFile
                    736:        0 sendln
                    737:        [(flush)] extension
                    738:        0 sendln
                    739:        [(flush)] extension
                    740:        /httpd_sendfile.L1 goto
                    741:      }{
                    742:        [(MSG) (Warning: unknown argument type for httpd_sendfile)]
                    743:        httpd_sendfile
                    744:      } ifelse
                    745:      /httpd_sendfile.L1
                    746:    ] pop
                    747:    popVariables
                    748: } def
                    749:
                    750: /httpd_type {
                    751:   /arg1 set
                    752:   [/in-httpd_type /fname /ftype /i /ans] pushVariables
                    753:   [
                    754:     /fname arg1 def
1.18      takayama  755:     fname getFileType /ftype set
                    756:
                    757:     /ans (text/plain) def  % .txt, .jar,
1.14      takayama  758:     ftype (gif) eq {
                    759:       /ans (image/gif) def
                    760:     }{ } ifelse
                    761:     ftype (jpeg) eq ftype (jpg) eq or {
                    762:       /ans (image/jpeg) def
                    763:     }{ } ifelse
                    764:     ftype (png) eq {
                    765:       /ans (image/png) def
                    766:     }{ } ifelse
                    767:     ftype (png) eq {
                    768:       /ans (image/png) def
                    769:     }{ } ifelse
                    770:     ftype (html) eq ftype (htm) eq or {
                    771:       /ans (text/html) def
                    772:     } {  } ifelse
1.18      takayama  773:     ftype (wav) eq {
                    774:       /ans (audio/x-wav) def
                    775:     } { } ifelse
                    776:     ftype (class) eq {
                    777:       /ans (application/octet-stream) def
                    778:     } { } ifelse
1.14      takayama  779:     /arg1 ans def
                    780:   ] pop
                    781:   popVariables
                    782:   arg1
                    783: } def
1.15      takayama  784:
                    785: /httpd.check_name {
                    786:  /arg1 set
                    787:  [/in-httpd.check_name /fname /invalid] pushVariables
                    788:  [
                    789:    /fname arg1 def
                    790:    /invalid 0 def
                    791:    [(regionMatches) fname [(..) (/.)]] extension 0 get -1 eq
                    792:    {
                    793:    } {
                    794:      (The file name contains .. or /. ) message
                    795:      /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1  goto
                    796:    } ifelse
                    797:    fname length 0 eq {
                    798:      (Warning: empty file name.)
                    799:      /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1  goto
                    800:    }{ } ifelse
                    801:    fname (array) dc 0 get 47 eq {
                    802:    }{
                    803:      (Warning: The first letter is not /) message
                    804:      /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1  goto
                    805:    } ifelse
                    806:    /httpd.check_name.L1
                    807:    /arg1 invalid def
                    808:  ] pop
                    809:  popVariables
                    810:  arg1
1.17      takayama  811: } def
                    812:
                    813: /httpd.startBrowserUnix {
                    814:   /arg1 set
                    815:   [/portnum /browser /cmd /fd /msg /htmlfn] pushVariables
                    816:   [
                    817:      arg1 /portnum set
                    818:      portnum toString /portnum set
                    819:      [(getenv) (OX_BROWSER)]  extension /browser set
                    820:      {
                    821:       browser tag 0 eq {
1.21    ! takayama  822:         [(ostype)] extension 1 get (mac) eq {
        !           823:           [(sleep 3 ; open http://localhost:) portnum ( & ) ] cat
        !           824:           /cmd set cmd message
        !           825:         }{
        !           826:           [(sleep 3 ; firefox http://localhost:) portnum ( & ) ] cat
        !           827:           /cmd set cmd message
        !           828:         }ifelse
1.17      takayama  829:         cmd system
                    830:         exit
                    831:        }{ } ifelse
                    832:        browser (mac) eq, browser (MAC) eq, or {
                    833:          (.sm1.httpd.startBrowserUnix.html) /htmlfn set
                    834:          htmlfn (w) file /fd set
                    835:          fd tag 0 eq { (httpd.startBrowserUnix fails to open a file.) error }
                    836:          { } ifelse
                    837:          [(<html><body>) nl
                    838:           (<a href="http://localhost:) portnum (">)
                    839:           (Click here to connect to the ox server)
                    840:           (</a>) nl
                    841:           (</body></html>) nl
                    842:          ] cat /msg set
                    843:          fd msg writestring  fd closefile
                    844:          [(sleep 3 ; open ) htmlfn ( &) ] cat
                    845:          /cmd set cmd message
                    846:          cmd system
                    847:          exit
                    848:        }{ } ifelse
                    849:        [(sleep 3 ; ) browser ( http://localhost:) portnum ( & ) ] cat
                    850:        /cmd set cmd message
                    851:        cmd system
                    852:        exit
                    853:      } loop
                    854:   ] pop
                    855:   popVariables
1.15      takayama  856: } def

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>