[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.15

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

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