--- /dev/null
+#include "util_url.h"
+#include "util_const.h"
+#include "util_string.h"
+#include "ml.h"
+#include "ustring.h"
+
+/*
+ genericurl = scheme ":" schemepart
+ scheme = 1*[ lowalpha | digit | "+" | "-" | "." ]
+ schemepart = *xchar | ip-schemepart
+ ip-schemepart = "//" login [ "/" urlpath ]
+ login = [ user [ ":" password ] "@" ] hostport
+ hostport = host [ ":" port ]
+ host = hostname | hostnumber
+ hostname = *[ domainlabel "." ] toplabel
+ domainlabel = alphadigit | alphadigit *[ alphadigit | "-" ] alphadigit
+ toplabel = alpha | alpha *[ alphadigit | "-" ] alphadigit
+ alphadigit = alpha | digit
+ hostnumber = digits "." digits "." digits "." digits
+ port = digits
+ user = *[ uchar | ";" | "?" | "&" | "=" ]
+ password = *[ uchar | ";" | "?" | "&" | "=" ]
+ urlpath = *xchar ; depends on protocol see section 3.1
+
+ lowalpha = "a" ... "z"
+ hialpha = "A" ... "Z"
+ alpha = lowalpha | hialpha
+ digit = "0" ... "9"
+ safe = "$" | "-" | "_" | "." | "+"
+ extra = "!" | "*" | "'" | "(" | ")" | ","
+ national = "{" | "}" | "|" | "\" | "^" | "~" | "[" | "]" | "`"
+ punctuation = "<" | ">" | "#" | "%" | <">
+ reserved = ";" | "/" | "?" | ":" | "@" | "&" | "="
+ hex = digit | "A" ... "F" | "a" ... "f"
+ escape = "%" hex hex
+
+ unreserved = alpha | digit | safe | extra
+ uchar = unreserved | escape
+ xchar = unreserved | reserved | escape
+ digits = 1*digit
+*/
+
+bool checkURL (ustring& url, upair* scheme, upair* delim, upair* user, upair* pass, upair* host, upair* port, upair* rest) {
+#define CDIGIT "0-9"
+#define CHEX CDIGIT "a-fA-F"
+#define CALPHA "a-zA-Z"
+#define CALPHADIGIT CALPHA CDIGIT
+#define MSB1CHAR "\x80-\xff"
+#define CSAFE "$\\-_.+"
+#define CEXTRA "!*'(),"
+#define CRESERVED ";/?:@&="
+#define CESCAPE "%[" CHEX "][" CHEX "]"
+#define CUNRESERVED CALPHADIGIT CSAFE CEXTRA
+#define WUCHAR "[" CUNRESERVED MSB1CHAR "]|" CESCAPE
+#define WXCHAR "[" CUNRESERVED CRESERVED MSB1CHAR "]|" CESCAPE
+#define WUSER "(" WUCHAR "|[;?&=])*"
+#define WPASSWORD WUSER
+#define WHOST "([" CALPHADIGIT "][" CALPHADIGIT "-]*\\.)*[" CALPHADIGIT "][" CALPHADIGIT "-]*"
+#define WHOSTPART "(" WHOST ")(:([" CDIGIT "]+))?"
+#define WLOGIN "((" WUSER ")(:(" WPASSWORD "))?@)?" WHOSTPART
+ uiterator b, e;
+ umatch m;
+ static uregex re_scheme ("^([a-z0-9][a-z0-9+.-]*):");
+ static uregex re_ippart ("^//" WLOGIN);
+ static uregex re_part ("^(" WXCHAR ")*");
+
+ b = url.begin ();
+ e = url.end ();
+ if (usearch (b, e, m, re_scheme)) {
+ // 1:scheme
+ if (scheme)
+ *scheme = m[1];
+ b = m[0].second;
+ if (usearch (b, e, m, re_ippart)) {
+ // 2:user, 5:password, 7:host, 10:port
+ if (delim) {
+ delim->first = b - 1;
+ delim->second = b + 2;
+ }
+ if (user)
+ *user = m[2];
+ if (pass)
+ *pass = m[5];
+ if (host)
+ *host = m[7];
+ if (port)
+ *port = m[10];
+ if (rest) {
+ rest->first = m[0].second;
+ rest->second = e;
+ }
+ return true;
+ } else if (usearch (b, e, m, re_part)) {
+ // 0:*xchar
+ if (m[0].second == e) {
+ if (delim) {
+ delim->first = b - 1;
+ delim->second = b;
+ }
+ if (rest)
+ *rest = m[0];
+ return true;
+ } else {
+ return false;
+ }
+ } else {
+ return false;
+ }
+ } else {
+ return false;
+ }
+}
+
+bool checkURLSafe (ustring& url) {
+ umatch m;
+ static uregex re ("^(" WXCHAR ")*$");
+
+ return usearch (url, m, re);
+}
+
+bool checkScheme (ustring& proto) {
+ umatch m;
+ static uregex re ("^([a-z0-9][a-z0-9+.-]*)$");
+
+ return usearch (proto, m, re);
+}
+
+static ustring urlencode (uiterator b, uiterator e, const uregex& re) {
+ umatch m;
+ ustring ans;
+
+ while (b < e && usearch (b, e, m, re)) {
+ while (b < m[0].first) {
+ if (*b == 0)
+ ans.append (uUScore);
+ else
+ ans.append (percentHEX (*b++));
+ }
+ ans.append (m[0].first, m[0].second);
+ b = m[0].second;
+ }
+ while (b < e) {
+ if (*b == 0)
+ ans.append (uUScore);
+ else
+ ans.append (percentHEX (*b++));
+ }
+
+ return ans;
+}
+
+ustring urlencode (uiterator b, uiterator e) {
+ static uregex re ("[" CUNRESERVED MSB1CHAR "]+");
+ return urlencode (b, e, re);
+}
+
+ustring urlencode_path (uiterator b, uiterator e) {
+ static uregex re ("[" CUNRESERVED "/" MSB1CHAR "]+");
+ return urlencode (b, e, re);
+}
+
+ustring buildQuery (MNode* query) {
+ int c = 0;
+ ustring ans;
+ ustring u;
+
+ while (query && query->isCons ()) {
+ MNode* a = query->car ();
+ if (a->isCons ()) {
+ if (c == 0)
+ ans.append (CharConst ("?"));
+ else
+ ans.append (CharConst ("&"));
+ c ++;
+ u = to_string (a->car ());
+ ans.append (urlencode (u.begin (), u.end ()));
+ ans.append (uEq);
+ u = to_string (a->cdr ());
+ ans.append (urlencode (u.begin (), u.end ()));
+ } else {
+ throw (to_string (a) + uErrorBadValue);
+ }
+ nextNode (query);
+ }
+ return ans;
+}
#include "motoroutput.h"
#include "util_check.h"
#include "util_string.h"
+#include "util_url.h"
#include "http-iconv.h"
#include "expr.h"
#include "ustring.h"
#include <iostream>
#include <fstream>
-static void location_sub (ustring& url, MNode* query, MNode* arg, MlEnv* mlenv) {
+static void location_sub (ustring& url, MNode* query, MlEnv* mlenv) {
+ upair scheme, delim, user, pass, host, port, rest;
+ ustring ans;
+
+ if (checkURL (url, &scheme, &delim, &user, &pass, &host, &port, &rest)) {
+ ans.assign (scheme.first, scheme.second).append (delim.first, delim.second);
+ if (user.first != user.second) {
+ ans.append (user.first, user.second);
+ if (pass.first != pass.second) {
+ ans.append (uColon).append (pass.first, pass.second);
+ }
+ ans.append (CharConst ("@"));
+ }
+ ans.append (host.first, host.second);
+ if (port.first != port.second) {
+ ans.append (uColon).append (port.first, port.second);
+ }
+ ans.append (urlencode_path (pass.first, pass.second));
+ } else {
+ ans.assign (urlencode_path (url.begin (), url.end ()));
+ }
+ if (query)
+ ans.append (buildQuery (query));
+
+ url = ans;
+}
+
+#if 0
+static void location_sub (ustring& url, MNode* query, MlEnv* mlenv) {
MNodePtr p;
MNode* a;
int c;
uiterator b, e;
umatch m;
- static uregex re ("^[a-z]{1,6}://[a-zA-Z0-9-]+(\\.[a-zA-Z0-9-]+)*(:[0-9]{1,5})?/");
+// static uregex re ("^[a-z]{1,6}://[a-zA-Z0-9-]+(\\.[a-zA-Z0-9-]+)*(:[0-9]{1,5})?/");
+ static uregex re ("^[a-z]{1,16}://[a-zA-Z0-9-]+(\\.[a-zA-Z0-9-]+)*(:[0-9]{1,5})?");
b = url.begin ();
e = url.end ();
nextNode (query);
}
+#if 0
while (arg) {
p = eval (arg->car (), mlenv);
}
nextNode (arg);
}
+#endif
}
+#endif
static void url_sub (const ustring& url, HTTPSend* http, bool noencode) {
ustring str;
/*DOC:
===forbidden===
(forbidden [#continue | :continue BOOL]) -> NIL
+403 Forbiddenレスポンスを出力する。
+continueオプションを付けない場合,以降のファンクションの実行を中断する。
*/
//#AFUNC forbidden ml_forbidden
/*DOC:
===location===
- (location [#continue | :continue BOOL] URL ['(NAME VALUE)...]) -> NIL
- (location [#continue | :continue BOOL] URL [:query '((NAME VALUE)...)]) -> NIL
+// (location [#continue | :continue BOOL] URL ['(NAME VALUE)...]) -> NIL
+ (location [#continue | :continue BOOL] URL [:query '((NAME VALUE)...) | #raw]) -> NIL
+
+Locationヘッダを含むレスポンスを出力する。
*/
//#AFUNC location ml_location
ustring url;
MNodePtr query;
bool cflag = false;
+ bool fraw = false;
std::vector<MNode*> params;
std::vector<MNode*> keywords;
- MNode* rest;
+// MNode* rest;
static paramList kwlist[] = {
{CharConst ("continue"), true},
{CharConst ("query"), false},
+ {CharConst ("raw"), true},
{NULL, 0, 0}
};
- setParams (arg, 1, ¶ms, kwlist, &keywords, &rest);
+// setParams (arg, 1, ¶ms, kwlist, &keywords, &rest);
+ setParams (arg, 1, ¶ms, kwlist, &keywords, NULL);
url = eval_text1 (params[0], mlenv);
if (keywords[0] && eval_bool (keywords[0], mlenv))
cflag = true;
if (keywords[1]) // query
query = eval (keywords[1], mlenv);
+ if (keywords[2] && eval_bool (keywords[2], mlenv)) // raw
+ fraw = true;
- location_sub (url, query (), rest, mlenv);
+ if (fraw) {
+ if (! checkURLSafe (url))
+ throw (url + ": bad URL.");
+ } else {
+// location_sub (url, query (), rest, mlenv);
+ location_sub (url, query (), mlenv);
+ }
mlenv->env->location (url);
if (! cflag)
/*DOC:
===location-html===
- (location-html URL [#continue | :continue BOOL] ['(NAME VALUE)...]) -> NIL
- (location-html URL [#continue | :continue BOOL] [:query '((NAME VALUE)...)]) -> NIL
+// (location-html URL [#continue | :continue BOOL] ['(NAME VALUE)...]) -> NIL
+ (location-html URL [#continue | :continue BOOL] [:query '((NAME VALUE)...) | #raw]) -> NIL
*/
//#AFUNC location-html ml_location_html
ustring url;
MNodePtr query;
bool cflag = false;
+ bool fraw = false;
std::vector<MNode*> params;
std::vector<MNode*> keywords;
- MNode* rest;
+// MNode* rest;
static paramList kwlist[] = {
{CharConst ("continue"), true},
{CharConst ("query"), false},
+ {CharConst ("raw"), true},
{NULL, 0, 0}
};
- setParams (arg, 1, ¶ms, kwlist, &keywords, &rest);
+// setParams (arg, 1, ¶ms, kwlist, &keywords, &rest);
+ setParams (arg, 1, ¶ms, kwlist, &keywords, NULL);
url = eval_text1 (params[0], mlenv);
if (keywords[0] && eval_bool (keywords[0], mlenv))
cflag = true;
if (keywords[1]) // query
query = eval (keywords[1], mlenv);
+ if (keywords[2] && eval_bool (keywords[2], mlenv)) // raw
+ fraw = true;
- location_sub (url, query (), rest, mlenv);
+ if (fraw) {
+ if (! checkURLSafe (url))
+ throw (url + ": bad URL.");
+ } else {
+// location_sub (url, query (), rest, mlenv);
+ location_sub (url, query (), mlenv);
+ }
mlenv->env->location_html (url);
if (! cflag)
}
/*DOC:
+===build-url===
+ (build-url SCHEME HOST PATH [:user NAME] [:password TEXT | :pw TEXT] [:port NUMBER] [:query '((NAME . VALUE) ...)]) -> STRING
+
+*/
+//#AFUNC build-url ml_build_url
+MNode* ml_build_url (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring scheme;
+ ustring host;
+ ustring path;
+ MNodePtr user;
+ MNodePtr pwd;
+ int port = 0;
+ MNodePtr query;
+ AutoDelete<ustring> ans;
+ ustring u;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("user"), false},
+ {CharConst ("password"), false},
+ {CharConst ("pw"), false},
+ {CharConst ("port"), false},
+ {CharConst ("query"), false},
+ {NULL, 0, 0}
+ };
+
+ setParams (arg, 3, ¶ms, kwlist, &keywords, NULL);
+ scheme = eval_text1 (params[0], mlenv);
+ host = eval_text1 (params[1], mlenv);
+ path = eval_text1 (params[2], mlenv);
+ if (keywords[0]) // user
+ user = eval (keywords[0], mlenv);
+ if (keywords[1]) // password
+ pwd = eval (keywords[1], mlenv);
+ if (keywords[2]) // pw
+ pwd = eval (keywords[2], mlenv);
+ if (keywords[3]) // port
+ port = eval_int (keywords[3], mlenv);
+ if (keywords[4]) // query
+ query = eval (keywords[4], mlenv);
+
+ if (! checkScheme (scheme))
+ throw (scheme + ": bad scheme.");
+ if (! checkHostname (host))
+ throw (host + ": bad hostname.");
+
+ ans = new ustring;
+ ans ()->append (scheme).append (CharConst ("://"));
+ if (user ()) {
+ u = to_string (user ());
+ omitCtrl (u);
+ ans ()->append (urlencode (u.begin (), u.end ()));
+ if (pwd ()) {
+ ans ()->append (uColon);
+ u = to_string (pwd ());
+ omitCtrl (u);
+ ans ()->append (urlencode (u.begin (), u.end ()));
+ }
+ ans ()->append (CharConst ("@"));
+ }
+ ans ()->append (host);
+ if (port > 0) {
+ ans ()->append (uColon).append (to_ustring (port));
+ }
+ if (path[0] != '/') {
+ ans ()->append (uSlash);
+ }
+ ans ()->append (urlencode_path (path.begin (), path.end ()));
+ if (query ()) {
+ ans ()->append (buildQuery (query ()));
+ }
+
+ return newMNode_str (ans.release ());
+}
+
+/*DOC:
+===build-url-path===
+ (build-url-path ELEMENT...) -> STRING
+
+*/
+//#AFUNC build-url-path ml_build_url_path
+MNode* ml_build_url_path (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ AutoDelete<ustring> ans;
+ ustring u;
+
+ ans = new ustring;
+ while (arg) {
+ u = eval_str (arg->car (), mlenv);
+ if (u.length () > 0)
+ ans ()->append (uSlash).append (urlencode (u.begin (), u.end ()));
+ nextNode (arg);
+ }
+
+ return newMNode_str (ans.release ());
+}
+
+/*DOC:
===$http-get==
($http-get URL [#get] [#post] [#put] [#delete] [#file]
[:id STRING] [:password STRING | :pw STRING]