modules/ml-http.cc

   1 #include "config.h"
   2 #include "ml-http.h"
   3 #include "ml.h"
   4 #include "mlenv.h"
   5 #include "motorenv.h"
   6 #include "motoroutput.h"
   7 #include "util_check.h"
   8 #include "util_string.h"
   9 #include "util_url.h"
  10 #include "http-iconv.h"
  11 #include "expr.h"
  12 #include "ustring.h"
  13 #include <iostream>
  14 #include <fstream>
  15 #include <time.h>
  16
  17 static void  location_sub (ustring& url, MNode* query, MlEnv* mlenv) {
  18     upair  scheme, delim, user, pass, host, port, rest;
  19     ustring  ans;
  20
  21     if (checkURL (url, &scheme, &delim, &user, &pass, &host, &port, &rest)) {
  22         ans.assign (scheme.first, scheme.second).append (delim.first, delim.second);
  23         if (user.first != user.second) {
  24             ans.append (user.first, user.second);
  25             if (pass.first != pass.second) {
  26                 ans.append (uColon).append (pass.first, pass.second);
  27             }
  28             ans.append (CharConst ("@"));
  29         }
  30         ans.append (host.first, host.second);
  31         if (port.first != port.second) {
  32             ans.append (uColon).append (port.first, port.second);
  33         }
  34 #ifdef QUERYENCODEALT
  35         ans.append (urlencode_path (rest.first, rest.second));
  36 #else
  37         ans.append (percentEncode_path (rest.first, rest.second));
  38 #endif
  39     } else {
  40 #ifdef QUERYENCODEALT
  41         ans.assign (urlencode_path (url.begin (), url.end ()));
  42 #else
  43         ans.assign (percentEncode_path (url.begin (), url.end ()));
  44 #endif
  45     }
  46     if (query)
  47         ans.append (buildQuery (query));
  48
  49     url = ans;
  50 }
  51
  52 static void  url_sub (const ustring& url, HTTPSend* http, bool noencode) {
  53     ustring  str;
  54     uiterator  b, e;
  55     umatch  m;
  56     static uregex  re ("^([a-z]{1,6})://([a-zA-Z0-9-]+(\\.[a-zA-Z0-9-]+)*)(:([0-9]{1,5}))?/");
  57
  58     str = omitCtrl (url);
  59     b = str.begin ();
  60     e = str.end ();
  61     if (usearch (b, e, m, re)) {
  62         http->proto = ustring (m[1].first, m[1].second);
  63         http->host.host = ustring (m[2].first, m[2].second);
  64         if (m[4].matched)
  65             http->host.port = to_uint32 (ustring (m[5].first, m[5].second));
  66         else
  67             if (http->proto == uHttps)
  68                 http->host.port = 443;
  69             else
  70                 http->host.port = 80;
  71         if (http->useproxy) {
  72             if (http->proto == uHttps) {
  73 //              throw (ustring (CharConst ("proxy connection of SSL protocol not implemented.")));
  74                 // XXX experimental https proxy connection.
  75                 if (noencode)
  76                     http->path = ustring (m[0].second - 1, e);
  77                 else
  78                     http->path = percentEncode_path (m[0].second - 1, e);
  79             } else {
  80                 if (noencode) {
  81                     http->path = str;
  82                 } else {
  83                     http->path = ustring (b, m[0].second - 1);
  84                     http->path.append (percentEncode_path (m[0].second - 1, e));
  85                 }
  86             }
  87         } else {
  88             http->conhost = http->host;
  89             if (noencode)
  90                 http->path = ustring (m[0].second - 1, e);
  91             else
  92                 http->path = percentEncode_path (m[0].second - 1, e);
  93         }
  94     } else {
  95 //      throw (str + ": bad URL.");
  96         http->proto.resize (0);
  97         http->host.host.resize (0);
  98         http->host.port = 0;
  99         if (noencode)
 100             http->path = str;
 101         else
 102             http->path = percentEncode_path (str);
 103     }
 104 }
 105
 106 static void  request_cookie (MNode* cookie, HTTPSend* http) {
 107     MNode*  a;
 108
 109     if (cookie && cookie->isCons ()) {
 110         while (cookie) {
 111             if ((a = cookie->car ())) {
 112                 if (a->isCons ()) {
 113                     http->cookie.push_back (HTTPSend::mapelem (to_string (a->car ()), to_string (a->cdr ())));
 114                 } else {
 115                     ustring  t = to_string (a);
 116                     ustring  u;
 117                     nextNode (cookie);
 118                     if (cookie)
 119                         u = to_string (cookie->car ());
 120                     http->cookie.push_back (HTTPSend::mapelem (t, u));
 121                 }
 122             }
 123             nextNode (cookie);
 124         }
 125     }
 126 }
 127
 128 static void  request_headerquery (MNode* headerquery, HTTPSend* http) {
 129     MNode*  a;
 130
 131     if (headerquery && headerquery->isCons ()) {
 132         while (headerquery) {
 133             if ((a = headerquery->car ())) {
 134                 if (a->isCons ()) {
 135                     http->header_req.push_back (HTTPSend::mapelem (to_string (a->car ()), to_string (a->cdr ())));
 136                 } else {
 137                     nextNode (headerquery);
 138                     if (headerquery)
 139                         http->header_req.push_back (HTTPSend::mapelem (to_string (a), to_string (headerquery->car ())));
 140                 }
 141             }
 142             nextNode (headerquery);
 143         }
 144     }
 145     return;
 146 }
 147
 148 /*DOC:
 149 ==http client==
 150
 151 */
 152 /*DOC:
 153 ===error===
 154  (error [#continue | :continue BOOL] [:error-var VARIABLE]) -> NIL
 155 error-htmlコマンドオプションで指定したひな形を出力する。
 156
 157 */
 158 //#AFUNC        error   ml_error
 159 MNode*  ml_error (MNode* cell, MlEnv* mlenv) {
 160     MNode*  arg = cell->cdr ();
 161     bool  cflag = false;
 162     MNodePtr  ev;
 163     std::vector<MNode*>  keywords;
 164     static paramList  kwlist[] = {
 165         {CharConst ("continue"), true},
 166         {CharConst ("error-var"), false},
 167         {NULL, 0, 0}
 168     };
 169
 170     setParams (arg, 0, NULL, kwlist, &keywords, NULL);
 171     if (keywords[0] && eval_bool (keywords[0], mlenv))
 172         cflag = true;
 173     if (keywords[1]) {
 174         ev = eval (keywords[1], mlenv);
 175     }
 176
 177     if (mlenv->env) {
 178         mlenv->env->setErrorFlag ();
 179         if (ev ()) {
 180             if (ev ()->isCons ()) {
 181                 MNode*  a = ev ();
 182                 while (a && a->isCons ()) {
 183                     mlenv->env->setErrorVar (to_string (a->car ()));
 184                     nextNode (a);
 185                 }
 186             } else {
 187                 mlenv->env->setErrorVar (to_string (ev ()));
 188             }
 189         }
 190     }
 191
 192     if (! cflag)
 193         mlenv->breakProg ();
 194
 195     return NULL;
 196 }
 197
 198 /*DOC:
 199 ===forbidden===
 200  (forbidden [#continue | :continue BOOL]) -> NIL
 201 403 Forbiddenレスポンスを出力する。
 202 continueオプションを付けない場合，以降のファンクションの実行を中断する。
 203
 204 */
 205 //#AFUNC        forbidden       ml_forbidden
 206 MNode*  ml_forbidden (MNode* cell, MlEnv* mlenv) {
 207     MNode*  arg = cell->cdr ();
 208     bool  cflag = false;
 209     std::vector<MNode*>  keywords;
 210     static paramList  kwlist[] = {
 211         {CharConst ("continue"), true},
 212         {NULL, 0, 0}
 213     };
 214
 215     setParams (arg, 0, NULL, kwlist, &keywords, NULL);
 216     if (keywords[0] && eval_bool (keywords[0], mlenv))
 217         cflag = true;
 218
 219     if (! mlenv->env->responseDone)
 220         mlenv->env->forbiddenResponse ();
 221     mlenv->env->setErrorFlag ();
 222
 223     if (! cflag)
 224         mlenv->breakProg ();
 225
 226     return NULL;
 227 }
 228
 229 /*DOC:
 230 ===no-content===
 231  (no-content [#continue | :continue BOOL]) -> NIL
 232 200 No Contentレスポンスを出力する。
 233 continueオプションを付けない場合，以降のファンクションの実行を中断する。
 234
 235 */
 236 //#AFUNC        no-content      ml_no_content
 237 MNode*  ml_no_content (MNode* cell, MlEnv* mlenv) {
 238     MNode*  arg = cell->cdr ();
 239     bool  cflag = false;
 240     std::vector<MNode*>  keywords;
 241     static paramList  kwlist[] = {
 242         {CharConst ("continue"), true},
 243         {NULL, 0, 0}
 244     };
 245
 246     setParams (arg, 0, NULL, kwlist, &keywords, NULL);
 247     if (keywords[0] && eval_bool (keywords[0], mlenv))
 248         cflag = true;
 249
 250     if (! mlenv->env->responseDone)
 251         mlenv->env->noContentResponse ();
 252     mlenv->env->setErrorFlag ();
 253
 254     if (! cflag)
 255         mlenv->breakProg ();
 256
 257     return NULL;
 258 }
 259
 260 /*DOC:
 261 ===location===
 262 // (location [#continue | :continue BOOL] URL ['(NAME VALUE)...]) -> NIL
 263  (location [#continue | :continue BOOL] URL [:query '((NAME . VALUE)...) | #raw]) -> NIL
 264
 265 Locationヘッダを含むレスポンスを出力する。
 266
 267 */
 268 //#AFUNC        location        ml_location
 269 MNode*  ml_location (MNode* cell, MlEnv* mlenv) {
 270     MNode*  arg = cell->cdr ();
 271     ustring  url;
 272     MNodePtr  query;
 273     bool  cflag = false;
 274     bool  fraw = false;
 275     std::vector<MNode*>  params;
 276     std::vector<MNode*>  keywords;
 277     static paramList  kwlist[] = {
 278         {CharConst ("continue"), true},
 279         {CharConst ("query"), false},
 280         {CharConst ("raw"), true},
 281         {NULL, 0, 0}
 282     };
 283
 284     setParams (arg, 1, &params, kwlist, &keywords, NULL);
 285     url = eval_text1 (params[0], mlenv);
 286     if (keywords[0] && eval_bool (keywords[0], mlenv))
 287         cflag = true;
 288     if (keywords[1])            // query
 289         query = eval (keywords[1], mlenv);
 290     if (keywords[2] && eval_bool (keywords[2], mlenv)) // raw
 291         fraw = true;
 292
 293     if (fraw) {
 294         if (! checkURLSafe (url))
 295             throw (url + ": bad URL.");
 296     } else {
 297 //      location_sub (url, query (), rest, mlenv);
 298         location_sub (url, query (), mlenv);
 299     }
 300     mlenv->env->location (url);
 301
 302     if (! cflag)
 303         mlenv->breakProg ();
 304
 305     return NULL;
 306 }
 307
 308 /*DOC:
 309 ===location-html===
 310 // (location-html URL [#continue | :continue BOOL] ['(NAME VALUE)...]) -> NIL
 311  (location-html URL [#continue | :continue BOOL] [:query '((NAME . VALUE)...) | #raw]) -> NIL
 312
 313 */
 314 //#AFUNC        location-html   ml_location_html
 315 MNode*  ml_location_html (MNode* cell, MlEnv* mlenv) {
 316     MNode*  arg = cell->cdr ();
 317     ustring  url;
 318     MNodePtr  query;
 319     bool  cflag = false;
 320     bool  fraw = false;
 321     std::vector<MNode*>  params;
 322     std::vector<MNode*>  keywords;
 323     static paramList  kwlist[] = {
 324         {CharConst ("continue"), true},
 325         {CharConst ("query"), false},
 326         {CharConst ("raw"), true},
 327         {NULL, 0, 0}
 328     };
 329
 330     setParams (arg, 1, &params, kwlist, &keywords, NULL);
 331     url = eval_text1 (params[0], mlenv);
 332     if (keywords[0] && eval_bool (keywords[0], mlenv))
 333         cflag = true;
 334     if (keywords[1])            // query
 335         query = eval (keywords[1], mlenv);
 336     if (keywords[2] && eval_bool (keywords[2], mlenv)) // raw
 337         fraw = true;
 338
 339     if (fraw) {
 340         if (! checkURLSafe (url))
 341             throw (url + ": bad URL.");
 342     } else {
 343         location_sub (url, query (), mlenv);
 344     }
 345     mlenv->env->location_html (url);
 346
 347     if (! cflag)
 348         mlenv->breakProg ();
 349
 350     return NULL;
 351 }
 352
 353 /*DOC:
 354 ===response-no-cache===
 355  (response-no-cache) -> NIL
 356
 357 */
 358 //#AFUNC        response-no-cache       ml_response_no_cache
 359 MNode*  ml_response_no_cache (MNode* cell, MlEnv* mlenv) {
 360     MNode*  arg = cell->cdr ();
 361
 362     if (arg)
 363         throw (uErrorWrongNumber);
 364
 365     mlenv->env->http.fNoCache = true;
 366
 367     return NULL;
 368 }
 369
 370 /*DOC:
 371 ===build-url===
 372  (build-url SCHEME HOST PATH [:user NAME] [:password TEXT | :pw TEXT] [:port NUMBER] [:query '((NAME . VALUE) ...)]) -> STRING
 373
 374 */
 375 //#AFUNC        build-url       ml_build_url
 376 MNode*  ml_build_url (MNode* cell, MlEnv* mlenv) {
 377     MNode*  arg = cell->cdr ();
 378     ustring  scheme;
 379     ustring  host;
 380     ustring  path;
 381     MNodePtr  user;
 382     MNodePtr  pwd;
 383     int  port = 0;
 384     MNodePtr  query;
 385     AutoDelete<ustring>  ans;
 386     ustring  u;
 387     MNodePtr  t;
 388     std::vector<MNode*>  params;
 389     std::vector<MNode*>  keywords;
 390     static paramList  kwlist[] = {
 391         {CharConst ("user"), false},
 392         {CharConst ("password"), false},
 393         {CharConst ("pw"), false},
 394         {CharConst ("port"), false},
 395         {CharConst ("query"), false},
 396         {NULL, 0, 0}
 397     };
 398
 399     setParams (arg, 3, &params, kwlist, &keywords, NULL);
 400     scheme = eval_text1 (params[0], mlenv);
 401     host = eval_text1 (params[1], mlenv);
 402     path = eval_text1 (params[2], mlenv);
 403     if (keywords[0])            // user
 404         user = eval (keywords[0], mlenv);
 405     if (keywords[1])            // password
 406         pwd = eval (keywords[1], mlenv);
 407     if (keywords[2])            // pw
 408         pwd = eval (keywords[2], mlenv);
 409     if (evkw (3, t))            // port
 410         port = to_int (t ());
 411     if (keywords[4])            // query
 412         query = eval (keywords[4], mlenv);
 413
 414     if (! checkScheme (scheme))
 415         throw (scheme + ": bad scheme.");
 416     if (! matchHostname (host))
 417         throw (host + ": bad hostname.");
 418
 419     ans = new ustring;
 420     ans ()->append (scheme).append (CharConst ("://"));
 421     if (user ()) {
 422         u = to_string (user ());
 423         omitCtrl (u);
 424 #ifdef QUERYENCODEALT
 425         ans ()->append (urlencode (u.begin (), u.end ()));
 426 #else
 427         ans ()->append (percentEncode (u.begin (), u.end ()));
 428 #endif
 429         if (pwd ()) {
 430             ans ()->append (uColon);
 431             u = to_string (pwd ());
 432             omitCtrl (u);
 433 #ifdef QUERYENCODEALT
 434             ans ()->append (urlencode (u.begin (), u.end ()));
 435 #else
 436             ans ()->append (percentEncode (u.begin (), u.end ()));
 437 #endif
 438         }
 439         ans ()->append (CharConst ("@"));
 440     }
 441     ans ()->append (host);
 442     if (port > 0) {
 443         ans ()->append (uColon).append (to_ustring (port));
 444     }
 445     if (path[0] != '/') {
 446         ans ()->append (uSlash);
 447     }
 448 #ifdef QUERYENCODEALT
 449     ans ()->append (urlencode_path (path.begin (), path.end ()));
 450 #else
 451     ans ()->append (percentEncode_path (path.begin (), path.end ()));
 452 #endif
 453     if (query ()) {
 454         ans ()->append (buildQuery (query ()));
 455     }
 456
 457     return newMNode_str (ans.release ());
 458 }
 459
 460 /*DOC:
 461 ===build-url-path===
 462  (build-url-path ELEMENT...) -> STRING
 463
 464 */
 465 //#AFUNC        build-url-path  ml_build_url_path
 466 MNode*  ml_build_url_path (MNode* cell, MlEnv* mlenv) {
 467     MNode*  arg = cell->cdr ();
 468     AutoDelete<ustring>  ans;
 469     ustring  u;
 470     MNodePtr  t;
 471     int  c = 0;
 472
 473     ans = new ustring;
 474     while (arg) {
 475         t = eval (arg->car (), mlenv);
 476         if (! isNil (t ())) {
 477             u = to_string (t ());
 478             if (c == 0) {
 479 #ifdef QUERYENCODEALT
 480                 ans ()->append (urlencode (u.begin (), u.end ()));
 481 #else
 482                 ans ()->append (percentEncode (u.begin (), u.end ()));
 483 #endif
 484                 c ++;
 485             } else {
 486 #ifdef QUERYENCODEALT
 487                 ans ()->append (uSlash).append (urlencode (u.begin (), u.end ()));
 488 #else
 489                 ans ()->append (uSlash).append (percentEncode (u.begin (), u.end ()));
 490 #endif
 491             }
 492         }
 493         nextNode (arg);
 494     }
 495
 496     return newMNode_str (ans.release ());
 497 }
 498
 499 /*DOC:
 500 ===build-query===
 501  (build-query '((NAME . VALUE)...)) -> STRING
 502
 503 */
 504 //#AFUNC        build-query     ml_build_query
 505 MNode*  ml_build_query (MNode* cell, MlEnv* mlenv) {
 506     MNode*  arg = cell->cdr ();
 507     MNodePtr  query;
 508     ustring  ans;
 509     MNode*  e;
 510     MNode*  a;
 511     int  c = 0;
 512
 513     if (!arg)
 514         throw (uErrorWrongNumber);
 515     query = eval (arg->car (), mlenv);
 516     nextNode (arg);
 517     if (arg)
 518         throw (uErrorWrongNumber);
 519
 520     e = query ();
 521     if (e && e->isCons ()) {
 522         while (e) {
 523             if ((a = e->car ())) {
 524                 if (c > 0)
 525                     ans.append (uAmp);
 526                 ans.append (percentEncode (to_string (a->car ())));
 527                 if (! isNil (a->cdr ())) {
 528                     ans.append (uEq);
 529                     ans.append (percentEncode (to_string (a->cdr ())));
 530                 }
 531                 c ++;
 532             }
 533             nextNode (e);
 534         }
 535     }
 536
 537     return newMNode_str (new ustring (ans));
 538 }
 539
 540 /*DOC:
 541 ===http-date===
 542  (http-date INTEGER) -> STRING
 543
 544 */
 545 //#AFUNC        http-date       ml_http_date
 546 MNode*  ml_http_date (MNode* cell, MlEnv* mlenv) {
 547     MNode*  arg = cell->cdr ();
 548     time_t  tm;
 549     struct tm  tms;
 550     char  b[64];
 551     size_t  s;
 552
 553     if (!arg)
 554         throw (uErrorWrongNumber);
 555     tm = eval_int64 (arg->car (), mlenv);
 556     nextNode (arg);
 557     if (arg)
 558         throw (uErrorWrongNumber);
 559
 560     gmtime_r (&tm, &tms);
 561     s = strftime (b, 64, "%a, %d %b %Y %H:%M:%S GMT", &tms);
 562
 563     return newMNode_str (new ustring (b, s));
 564 }
 565
 566 /*DOC:
 567 ===hostnamep===
 568  (hostnamep STRING) -> BOOL
 569
 570 */
 571 //#AFUNC        hostnamep       ml_hostnamep
 572 MNode*  ml_hostnamep (MNode* cell, MlEnv* mlenv) {
 573     MNode*  arg = cell->cdr ();
 574     ustring  hostname;
 575
 576     if (!arg)
 577         throw (uErrorWrongNumber);
 578     hostname = eval_str (arg->car (), mlenv);
 579     nextNode (arg);
 580     if (arg)
 581         throw (uErrorWrongNumber);
 582
 583     return newMNode_bool (matchHostname (hostname));
 584 }
 585
 586 /*DOC:
 587 ===$http-get==
 588  ($http-get URL [#get] [#post] [#put] [#delete] [#file] [#head]
 589         [:id STRING] [:password STRING | :pw STRING]
 590         [:query '((NAME . VALUE) ...)] [:get-query '((NAME . VALUE) ...)]
 591         [:post-file-serial '((NAME . VALUE) ...)]
 592         [:post-file-named '((NAME . VALUE) ...)]
 593         [:post-file-static '((NAME . VALUE) ...)]
 594         [:raw-query TEXT]
 595         [:raw-file-serial NAME] [:raw-file-named NAME] [:raw-file-static NAME]
 596         [:query-type MIMETYPE]
 597         [:cookie '((NAME . VALUE) ...)] [:header '((NAME . VALUE) ...)]
 598         [:proxy-host STRING] [:proxy-port NUMBER]
 599         [:proxy-id STRING] [:proxy-password STRING | :proxy-pw STRING]
 600         [#sjis] [#euc-jp] [:iconv NAME]
 601         [:on-error FUNCTION]
 602         [#no-verify] [#no-encode]
 603         [SUBFUNCTION...]) -> LAST VALUE
 604
 605 */
 606 //#MFUNC        $http-get       ml_http_get     cMLHttpGetID
 607 MNode*  ml_http_get (MNode* cell, MlEnv* mlenv) {
 608     MNode*  arg = cell->cdr ();
 609     MLHttpGet  obj (mlenv);
 610     ustring  url;
 611     MNodePtr  cookie;
 612     MNodePtr  headerquery;
 613     MNodePtr  errfn;
 614     bool  fnoverify = false;
 615     bool  fnoencode = false;
 616     std::vector<MNode*>  params;
 617     std::vector<MNode*>  keywords;
 618     MNode*  rest;
 619     MNodePtr  ans;
 620     MNodePtr  t;
 621     int  rc;
 622     static paramList  kwlist[] = {
 623         {CharConst ("get"), true},      // 0
 624         {CharConst ("post"), true},     // 1
 625         {CharConst ("put"), true},      // 2
 626         {CharConst ("delete"), true},   // 3
 627         {CharConst ("file"), true},     // 4
 628         {CharConst ("id"), false},      // 5
 629         {CharConst ("password"), false}, // 6
 630         {CharConst ("pw"), false},      // 7
 631         {CharConst ("query"), false},   // 8
 632         {CharConst ("get-query"), false},       // 9
 633         {CharConst ("post-file-serial"), false}, // 10
 634         {CharConst ("post-file-named"), false}, // 11
 635         {CharConst ("post-file-static"), false}, // 12
 636         {CharConst ("cookie"), false},  // 13
 637         {CharConst ("header"), false},  // 14
 638         {CharConst ("proxy-host"), false},      // 15
 639         {CharConst ("proxy-port"), false},      // 16
 640         {CharConst ("proxy-id"), false},        // 17
 641         {CharConst ("proxy-password"), false},  // 18
 642         {CharConst ("proxy-pw"), false},        // 19
 643         {CharConst ("sjis"), true},             // 20
 644         {CharConst ("euc-jp"), true},           // 21
 645         {CharConst ("iconv"), false},           // 22
 646         {CharConst ("on-error"), false},        // 23
 647         {CharConst ("no-verify"), true},        // 24
 648         {CharConst ("raw-query"), false},       // 25
 649         {CharConst ("query-type"), false},      // 26
 650         {CharConst ("raw-file-serial"), false}, // 27
 651         {CharConst ("raw-file-named"), false},  // 28
 652         {CharConst ("raw-file-static"), false}, // 29
 653         {CharConst ("no-encode"), true},        // 30
 654         {CharConst ("head"), true},     // 31
 655         {NULL, 0, 0}
 656     };
 657
 658     setParams (arg, 1, &params, kwlist, &keywords, &rest);
 659     url = eval_str (params[0], mlenv);
 660     assert (obj.http == NULL);
 661     if (keywords[20] && eval_bool (keywords[20], mlenv)) // sjis
 662         obj.http = new HTTPSendIConv ("SHIFT_JIS");
 663     else if (keywords[21] && eval_bool (keywords[21], mlenv)) // euc-jp
 664         obj.http = new HTTPSendIConv ("EUC-JP");
 665     else if (evkw (22, t)) {
 666         ustring  code = to_string (t ());
 667         static uregex  re ("^[a-zA-Z0-9][a-zA-Z0-9_.:-]*$");
 668         umatch  m;
 669         if (usearch (code, m, re)) {
 670             obj.http = new HTTPSendIConv (code.c_str ()); // throw on error
 671         } else {
 672             throw (ustring (code).append (CharConst (": unknown encoding.")));
 673         }
 674     } else
 675         obj.http = new HTTPSend;
 676     if (keywords[0] && eval_bool (keywords[0], mlenv)) // get
 677         obj.http->setMethod (HTTPSend::M_GET);
 678     if (keywords[1] && eval_bool (keywords[1], mlenv)) // post
 679         obj.http->setMethod (HTTPSend::M_POST);
 680     if (keywords[2] && eval_bool (keywords[2], mlenv)) // put
 681         obj.http->setMethod (HTTPSend::M_PUT);
 682     if (keywords[3] && eval_bool (keywords[3], mlenv)) // delete
 683         obj.http->setMethod (HTTPSend::M_DELETE);
 684     if (keywords[31] && eval_bool (keywords[31], mlenv)) // head
 685         obj.http->setMethod (HTTPSend::M_HEAD);
 686     if (keywords[4] && eval_bool (keywords[4], mlenv)) // file
 687         obj.http->setPostFileMethod ();
 688     if (evkw (5, t))            // id
 689         obj.http->id = omitCtrl (to_string (t ()));
 690     if (evkw (6, t))            // password
 691         obj.http->pw = omitCtrl (to_string (t ()));
 692     if (evkw (7, t))            // pw
 693         obj.http->pw = omitCtrl (to_string (t ()));
 694     if (evkw (8, t))            // query
 695         obj.http->params = t ();
 696     if (evkw (9, t))            // get-query
 697         obj.http->getparams = t ();
 698     if (evkw (10, t))           // post-file-serial
 699         obj.http->fileparams_store = t ();
 700     if (evkw (11, t))           // post-file-named
 701         obj.http->fileparams_storage = t ();
 702     if (evkw (12, t))           // post-file-static
 703         obj.http->fileparams_static = t ();
 704     if (evkw (13, t))           // cookie
 705         cookie = t ();
 706     if (evkw (14, t))           // header
 707         headerquery = t ();
 708     if (evkw (15, t)) {         // proxy-host
 709         obj.http->conhost.host = omitNonAsciiWord (to_string (t ()));
 710         obj.http->useproxy = true;
 711         if (evkw (16, t))               // proxy-port
 712             obj.http->conhost.port = to_uint32 (to_string (t ()));
 713         if (evkw (17, t))               // proxy-id
 714             obj.http->proxyid = omitCtrl (to_string (t ()));
 715         if (evkw (18, t))               // proxy-password
 716             obj.http->proxypw = omitCtrl (to_string (t ()));
 717         if (evkw (19, t))               // proxy-pw
 718             obj.http->proxypw = omitCtrl (to_string (t ()));
 719     }
 720     if (keywords[23])
 721         errfn = eval (keywords[23], mlenv);
 722     if (keywords[24])
 723         fnoverify = eval_bool (keywords[24], mlenv);
 724     if (evkw (25, t))
 725         obj.http->rawquery = to_string (t ());
 726     if (evkw (26, t)) {
 727         obj.http->querytype = to_string (t ());
 728         if (! matchASCII (obj.http->querytype.begin (), obj.http->querytype.end ()))
 729             throw (obj.http->querytype + ustring (CharConst (": bad type")));
 730     }
 731     if (evkw (27, t))           // raw-file-serial
 732         obj.http->rawqueryfile = mlenv->env->path_store_file (to_string (t ()));
 733     if (evkw (28, t))           // raw-file-named
 734         obj.http->rawqueryfile = mlenv->env->path_storage_file (to_string (t ()));
 735     if (evkw (29, t))           // raw-file-static
 736         obj.http->rawqueryfile = mlenv->env->path_static_file (to_string (t ()));
 737     if (keywords[30])           // no-encode
 738         fnoencode = eval_bool (keywords[30], mlenv);
 739
 740     url_sub (url, obj.http, fnoencode);
 741     if (obj.http->proto.empty ()) {
 742         throw (obj.http->path + ": bad URL.");
 743     }
 744     request_cookie (cookie (), obj.http);
 745     request_headerquery (headerquery (), obj.http);
 746
 747     rc = 0;
 748     if (obj.http->proto == uHttp) {
 749         if (! obj.client) {
 750             TcpClient*  c = new TcpClient;
 751             obj.client = c;
 752             rc = c->connect (&obj.http->conhost);
 753         }
 754         if (rc)
 755             obj.http->submit (*obj.client, obj.buf, mlenv);
 756     } else if (obj.http->proto == uHttps) {
 757         if (obj.http->useproxy) {
 758             if (! obj.client) {
 759                 ProxySslClient* c = new ProxySslClient (fnoverify);
 760                 c->proxyid = obj.http->proxyid;
 761                 c->proxypw = obj.http->proxypw;
 762                 obj.http->proxyid = uEmpty;
 763                 obj.http->proxypw = uEmpty;
 764                 obj.client = c;
 765                 rc = c->connect (&obj.http->conhost, &obj.http->host);
 766             }
 767             obj.http->useproxy = false;
 768         } else {
 769             if (! obj.client) {
 770                 SslClient*  c = new SslClient (fnoverify);
 771                 obj.client = c;
 772                 rc = c->connect (&obj.http->conhost, &obj.http->host);
 773             }
 774         }
 775         if (rc)
 776             obj.http->submit (*obj.client, obj.buf, mlenv);
 777     } else {
 778         throw (obj.http->proto + ": protocol not supported.");
 779     }
 780     obj.http->readReplyHead (*obj.client, obj.buf);
 781
 782     mlenv->setMStack (&obj);
 783     try {
 784         ans = progn (rest, mlenv);
 785     } catch (ustring& msg) {
 786         if (errfn ()) {
 787             onErrorFn (errfn (), mlenv);
 788         } else {
 789             throw (msg);
 790         }
 791     }
 792     mlenv->stopBreak (cell->car ());
 793
 794     return ans.release ();
 795 }
 796
 797 /*DOC:
 798 ===subfunctions of $http-get===
 799
 800 */
 801 /*DOC:
 802 ====http-status====
 803  (http-status) -> NUMBER
 804
 805 */
 806 //#SFUNC        http-status     ml_http_get_http_status
 807 MNode*  ml_http_get_http_status (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 808     MNode*  arg = cell->cdr ();
 809     MLHttpGet*  obj = (MLHttpGet*)mobj;
 810
 811     if (arg)
 812         throw (uErrorWrongNumber);
 813
 814     return newMNode_num (obj->http->responseCode);
 815 }
 816
 817 /*DOC:
 818 ====http-response====
 819  (http-response) -> STRING
 820
 821 */
 822 //#SFUNC        http-response   ml_http_get_http_response
 823 MNode*  ml_http_get_http_response (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 824     MNode*  arg = cell->cdr ();
 825     MLHttpGet*  obj = (MLHttpGet*)mobj;
 826     ustring  ans;
 827
 828     if (arg)
 829         throw (uErrorWrongNumber);
 830
 831     obj->http->readReplyBody (*obj->client, obj->buf, ans);
 832
 833     return newMNode_str (new ustring (ans));
 834 }
 835
 836 /*DOC:
 837 ====http-response-file====
 838  (http-response-file FILENAME) -> NIL
 839
 840 */
 841 //#SFUNC        http-response-file      ml_http_get_http_response_file
 842 MNode*  ml_http_get_http_response_file (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 843     MNode*  arg = cell->cdr ();
 844     MLHttpGet*  obj = (MLHttpGet*)mobj;
 845     ustring  name;
 846     ustring  tgt, tmp;
 847
 848     if (! arg)
 849         throw (uErrorWrongNumber);
 850     name = eval_str (arg->car (), mlenv);
 851     nextNode (arg);
 852     if (arg)
 853         throw (uErrorWrongNumber);
 854
 855     tgt = mlenv->env->path_store_file (name);
 856     tmp.assign (tgt).append (CharConst ("-tmp")).append (to_ustring (getpid ()));
 857     {
 858         std::ofstream  stream;
 859         MotorOutputOStream  out (&stream);
 860         stream.open (tmp.c_str (), std::ios_base::out | std::ios_base::binary);
 861         obj->http->readReplyBody (*obj->client, obj->buf, &out);
 862         stream.close ();
 863         rename (tmp.c_str (), tgt.c_str ());
 864     }
 865
 866     return NULL;
 867 }
 868
 869 /*DOC:
 870 ====http-response-output====
 871  (http-response-output [#continue | :continue BOOL]) -> NIL
 872
 873 */
 874 //#SFUNC        http-response-output    ml_http_get_http_response_output
 875 MNode*  ml_http_get_http_response_output (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 876     MNode*  arg = cell->cdr ();
 877     MLHttpGet*  obj = (MLHttpGet*)mobj;
 878     bool  cflag = false;
 879     std::vector<MNode*>  keywords;
 880     static paramList  kwlist[] = {
 881         {CharConst ("continue"), true},
 882         {NULL, 0, 0}
 883     };
 884
 885     setParams (arg, 0, NULL, kwlist, &keywords, NULL);
 886     if (keywords[0] && eval_bool (keywords[0], mlenv))
 887         cflag = true;
 888
 889     if (! mlenv->env->responseDone)
 890         mlenv->env->standardResponse_html ();
 891     obj->http->readReplyBody (*obj->client, obj->buf, mlenv->env->output);
 892
 893     if (! cflag)
 894         mlenv->breakProg ();
 895
 896     return NULL;
 897 }
 898
 899 /*DOC:
 900 ====get-cookie====
 901  (get-cookie NAME) -> STRING
 902
 903 */
 904 //#SFUNC        get-cookie      ml_http_get_get_cookie
 905 MNode*  ml_http_get_get_cookie (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 906     MNode*  arg = cell->cdr ();
 907     MLHttpGet*  obj = (MLHttpGet*)mobj;
 908     ustring  name;
 909     int  i;
 910
 911     if (! arg)
 912         throw (uErrorWrongNumber);
 913     name = eval_str (arg->car (), mlenv);
 914     nextNode (arg);
 915     if (arg)
 916         throw (uErrorWrongNumber);
 917
 918     for (i = 0; i < obj->http->cookie_reply.size (); i ++) {
 919         if (obj->http->cookie_reply[i].key == name) {
 920             return newMNode_str (new ustring (obj->http->cookie_reply[i].value));
 921         }
 922     }
 923
 924     return NULL;
 925 }
 926
 927 /*DOC:
 928 ====get-cookie-all====
 929  (get-cookie-all) -> LIST of (NAME . VALUE)
 930
 931 */
 932 //#SFUNC        get-cookie-all  ml_http_get_get_cookie_all
 933 MNode*  ml_http_get_get_cookie_all (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 934     MNode*  arg = cell->cdr ();
 935     MLHttpGet*  obj = (MLHttpGet*)mobj;
 936     MNodeList  ans;
 937     int  i;
 938     MNode*  a;
 939
 940     if (arg)
 941         throw (uErrorWrongNumber);
 942
 943     for (i = 0; i < obj->http->cookie_reply.size (); i ++) {
 944         a = new MNode;
 945         a->set_car (newMNode_str (new ustring (obj->http->cookie_reply[i].key)));
 946         a->set_cdr (newMNode_str (new ustring (obj->http->cookie_reply[i].value)));
 947         ans.append (a);
 948     }
 949
 950     return ans.release ();
 951 }
 952
 953 /*DOC:
 954 ====http-content-type====
 955  (http-content-type) -> STRING
 956
 957 */
 958 //#SFUNC        http-content-type       ml_http_content_type
 959 MNode*  ml_http_content_type (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 960     MNode*  arg = cell->cdr ();
 961     MLHttpGet*  obj = (MLHttpGet*)mobj;
 962     const ustring*  u;
 963     static ustring  name (CharConst ("content-type"));
 964
 965     u = obj->http->findHeader (name);
 966     if (u) {
 967         uiterator  b, e, m;
 968         b = u->begin ();
 969         e = u->end ();
 970         if (splitChar (b, e, ';', m)) {
 971             return newMNode_str (new ustring (toLower (b, m)));
 972         } else {
 973             return newMNode_str (new ustring (toLower (b, e)));
 974         }
 975     } else {
 976         return NULL;
 977     }
 978 }
 979
 980 /*DOC:
 981 ====http-get-header====
 982  (http-get-header NAME) -> STRING
 983
 984 */
 985 //#SFUNC        http-get-header ml_http_get_header
 986 MNode*  ml_http_get_header (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
 987     MNode*  arg = cell->cdr ();
 988     MLHttpGet*  obj = (MLHttpGet*)mobj;
 989     ustring  name;
 990     const ustring*  u;
 991
 992     if (! arg)
 993         throw (uErrorWrongNumber);
 994     name = eval_str (arg->car (), mlenv);
 995     nextNode (arg);
 996     if (arg)
 997         throw (uErrorWrongNumber);
 998
 999     name = toLower (name.begin (), name.end ());
1000     u = obj->http->findHeader (name);
1001     if (u) {
1002         return newMNode_str (new ustring (*u));
1003     } else {
1004         return NULL;
1005     }
1006 }
1007
1008 /*DOC:
1009 ====http-get-header-all====
1010  (http-get-header-all) -> LIST of (NAME . VALUE)
1011
1012 */
1013 //#SFUNC        http-get-header-all     ml_http_get_header_all
1014 MNode*  ml_http_get_header_all (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
1015     MNode*  arg = cell->cdr ();
1016     MLHttpGet*  obj = (MLHttpGet*)mobj;
1017     MNodeList  ans;
1018     MNode*  a;
1019     std::vector<HTTPSend::mapelem>::const_iterator  b = obj->http->header_reply.begin ();
1020     std::vector<HTTPSend::mapelem>::const_iterator  e = obj->http->header_reply.end ();
1021
1022     if (arg)
1023         throw (uErrorWrongNumber);
1024
1025     for (; b < e; b ++) {
1026         a = new MNode;
1027         a->set_car (newMNode_str (new ustring (b->first)));
1028         a->set_cdr (newMNode_str (new ustring (b->second)));
1029         ans.append (a);
1030     }
1031
1032     return ans.release ();
1033 }
1034