/* *********************************************************************

This source file is a part of the standard library of Scol
For the latest info, see http://www.scolring.org

Copyright (c) 2013 Stephane Bisaro aka Iri.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA 02111-1307, USA, or go to

http://www.gnu.org/copyleft/lesser.txt

********************************************************************* */

/*
 * Common network standard functions
 * See http://redmine.scolring.org/projects/tutorials/wiki/Scol_usage
 * for more informations
 */

/*! \file net.pkg
 * \author Scol team
 * \version 0.1
 * \copyright GNU Lesser General Public License 2.0 or later
	* \brief Scol Standard Library - Common network API
	*
	* Required : lib/std/string.pkg
 * 
**/


proto std_netBuildListFromParams = fun [S] [[S S] r1];;

/* fun [S] [[ S S] r1] (key, value) */
fun std_netparseurlparams2 (szParams)=
	std_netBuildListFromParams szParams;;
				
fun std_netparseurlparams (str, flag)=	// flag = 0 -> GET, 1 -> POST
	if !flag then
		let strfind "?" str 0 -> pos in
		if pos == nil then
			nil
		else
			std_netparseurlparams2 substr str pos+1 strlen str
	else
		std_netparseurlparams2 str;;

	
fun std_getshalshinurl (s, start)=
	let strfind "/" s start -> pos1 in
	let strfind ":" s start -> pos2 in
	if (pos2 < pos1) && (pos2 != nil) then pos2
	else pos1;;
	
fun std_netgetdomain (url, lProtocol)=
	if lProtocol == nil then
		nil
	else
		if !strcmp substr url 0 strlen hd lProtocol hd lProtocol then
			let std_getshalshinurl substr url strlen hd lProtocol strlen url strlen hd lProtocol -> end in
			let substr url strlen hd lProtocol end -> szRes in
			if std_szIsPattern szRes "[aZ][09].-_" then
				szRes
			else
				nil
		else
			std_netgetdomain url tl lProtocol;;
	
/*! \brief Return the domain (or the IP address if any) in an url.
*
* "http://www.example.com:1234/dir/file.html" -> "www.example.com"
*
* "http://www.example.com/dir/file.html" -> "www.example.com"
*
* "http://1.2.3.4:1234/dir/file.html" -> "1.2.3.4"
*
* \ingroup std_net
* <b>Prototype :</b> fun [S] S
*
* \param S : an url
*
* \return S : the domain or nil if undefined
* \remark Known protocols : http, https, file, ftp, ftps, sftp, scol.
**/	
fun std_netGetDomain (url)=
	let "https://"::"http://"::"file://"::"ftp://"::"sftp://"::"ftps://"::"scol://"::nil -> lProtocol in
	std_netgetdomain url lProtocol;;
	
	
/*! \brief Parse a received request.
*
* \ingroup std_net
* <b>Prototype :</b>fun [S] [S S S S S S S S S S [[S S] r1]]
*
* \param S : a string received request
*
* \return [S S S S S S S S S S [[S S] r1]] : a tuple :
* - S : the "host",
* - S : the "port" (80 by default),
* - S : the "user agent",
* - S : the used HTTP "protocol" (generally 1.0 or 1.1),
* - S : the "verb" (GET, POST, ...),
* - S : the data type (= the value of "Content-Type" header),
* - S : the language (= the value of "Content-Language" or "Accept-Language" header),
* - S : the size(lenght) of :
* 	-# the "url", if the "verb" is "GET",
* 	-# the "body" (exactly the value of the "Content-Lenght" header), if the "verb" is "POST",
* - S : the asked "url" (without the host),
* - S : the "body", the body content, if the "verb" is "POST" (should be nil with "GET"),
* - [[S S] r1] : a list with key, value which have been received in the request. If unable
* to find keys,values but the string is not empty, the string is returned in the first item 
* of the tuple (in this case, the list has one element (tuple) only).
*
* \remark If a value is not found, it will be nil, except for the port.
**/	
fun std_netParseRequest (szReq)=
	let [nil nil nil nil "other" nil nil nil nil nil nil] -> [host port agent protocol verb ctype clang len url body params] in
	(
	let strfindi "Host: " szReq 0 -> pos in
	(
	set host = if pos == nil then 
					nil 
				else 
					let strfind " " szReq pos+6 -> end1 in
					let strfind "\n" szReq pos+6 -> end2 in
					let strfind ":" szReq pos+6 -> end3 in
					let if end1 == nil then end2 
						else if end2 == nil then end1 
						else if end1 > end2 then end2 
						else end1 -> end in
					let if end > end3 then end3 else end -> end in
					strtrim substr szReq pos+6 end-pos-6;
	set pos = strfindi ":" szReq pos+6;
	set port = if pos == nil then 
					"80" 
				else 
					let strfind " " szReq pos+1 -> end1 in
					let strfind "\n" szReq pos+1 -> end2 in
					let if end1 == nil then end2 else if end2 == nil then end1 else if end1 > end2 then end2 else end1 -> end in
					strtrim substr szReq pos+1 end-pos-1;
	);
	let strfindi "User-Agent:" szReq 0 -> pos in
	set agent = if pos == nil then 
					nil 
				else 
					let strfind ")" szReq pos -> end in
					if end == nil then
						let strfind " " szReq pos+11 -> end1 in
						let strfind "\n" szReq pos+11 -> end2 in
						(
						set end = if end1 == nil then end2 else if end2 == nil then end1 else if end1 > end2 then end2 else end1 ;
						strtrim substr szReq pos+11 end-pos-11
						)
					else
						strtrim substr szReq pos+11 end-pos-11;
	let strfindi "HTTP/" szReq 0 -> pos in
	set protocol = if pos == nil then 
					nil
				else 
					let strfind " " szReq pos+5 -> end1 in
					let strfind "\n" szReq pos+5 -> end2 in
					let if end1 == nil then end2 else if end2 == nil then end1 else if end1 > end2 then end2 else end1 -> end in
					strtrim substr szReq pos+5 end-pos-5;
	let strfindi "Content-Type: " szReq 0 -> pos in
	set ctype = if pos == nil then 
					nil 
				else 
					let strfind "\n" szReq pos+14 -> end in
					strtrim substr szReq pos+14 end-pos-14;
	let strfindi "Content-Language: " szReq 0 -> pos in
	set clang = if pos == nil then 
					nil 
				else 
					let strfind "\n" szReq pos+18 -> end in
					strtrim substr szReq pos+18 end-pos-18;
	if clang == nil then
		let strfindi "Accept-Language: " szReq 0 -> pos in
		set clang = if pos == nil then 
						nil 
					else 
						let strfind "\n" szReq pos+17 -> end in
						strtrim substr szReq pos+17 end-pos-17
	else
		nil;
	let strfindi "GET " szReq 0 -> pos in
	if pos != nil then 
		(
		set verb = "GET";
		let strfind " " szReq pos+4 -> end1 in
		let strfind "\n" szReq pos+4 -> end2 in
		let if end1 == nil then end2 else if end2 == nil then end1 else if end1 > end2 then end2 else end1 -> end in
		set url = if pos == nil then
						nil
					else
						strtrim substr szReq pos+4 end-pos-4;
		set params = std_netparseurlparams url 0;
		set len = itoa strlen url;
		)
	else 
		nil;
	let strfindi "POST " szReq 0 -> pos in
	if pos != nil then 
		(
		set verb = "POST";
		let strfind " " szReq pos+5 -> end1 in
		let strfind "\n" szReq pos+5 -> end2 in
		let if end1 == nil then end2 else if end2 == nil then end1 else if end1 > end2 then end2 else end1 -> end in
		set url = if pos == nil then
						nil
					else
						strtrim substr szReq pos+5 end-pos-5;
		let strfindi "Content-Length: " szReq 0 -> pos in
		let strfind " " szReq pos+16 -> end1 in
		let strfind "\n" szReq pos+16 -> end2 in
		let if end1 == nil then end2 else if end2 == nil then end1 else if end1 > end2 then end2 else end1 -> end in
		set len = strtrim substr szReq pos+16 end-pos-16;
		set pos = strfind "\13\10\13\10" szReq 0;	// body starts always after
		set body = substr szReq pos+4 strlen szReq;
		set params = std_netparseurlparams body 1;
		)
	else 
		nil;
	/*_fooS host;
	_fooS port;
	_fooS agent;
	_fooS protocol;
	_fooS verb;
	_fooS ctype;
	_fooS clang;
	_fooS len;
	_fooS url;
	_fooS body;*/
	[host port agent protocol verb ctype len url body params]
	);;

/*! \brief Return the header of a received request object.
*
* \ingroup std_net
* <b>Prototype :</b>fun [S] S
* 
* \param S : a valid request string
*
* \return S : the header or nil if the request is invalid
*/
fun std_netGetHeader (szReq)=
	let strfind "\13\10\13\10" szReq 0 -> pos in
	if pos == nil then
		szReq
	else
		substr szReq 0 pos;;
		
/*! \brief Return the body of a received request object.
*
* \ingroup std_net
* <b>Prototype :</b>fun [S] S
* 
* \param S : a valid request string
*
* \return S : the body or nil if no body found (with "GET" by example)
*/
fun std_netGetBody (szReq)=
	let strfind "\13\10\13\10" szReq 0 -> pos in
	if pos == nil then
		nil
	else
		substr szReq pos+4 strlen szReq;;
		
/*! \brief Function to convert a string parameters like a=b&c=d ...
* to a list key,value. The given string should be already parsed (the params only).
*
* \ingroup std_net
* <b>Prototype :</b>fun [S] [[S S] r1]
* 
* \param S : an already parsed string, typically from an url (GET) or a body (POST)
*
* "param1=a&param2=b" -> [["param1" "a"] :: ["param2" "b"] :: nil
*
* \return [[S S] r1] : this list or nil if the request is invalid
* \remark If this function is unable to find keys,values, it returns
* a list with one tuple only, the full string is in the first item of
* the tuple.
* \see std_netGetParamsInUrl
*/
fun std_netBuildListFromParams (szParams)=
	if std_szIsEmpty szParams then
		nil
	else
		let strfind "=" szParams 0 -> pos1 in
		if pos1 == nil then
			[szParams nil] :: nil
		else
			let strfind "&" szParams pos1 -> pos2 in
			if pos2 != nil then
				/*let _fooS strcat "KEY = " substr szParams 0 pos1 -> _ in
				let _fooS strcat "VALUE = " substr szParams pos1+1 pos2-pos1-1 -> _ in*/
				[substr szParams 0 pos1 substr szParams pos1+1 pos2-pos1-1] :: std_netBuildListFromParams substr szParams pos2+1 strlen szParams
			else
				/*let _fooS strcat "KEY = " substr szParams 0 pos1 -> _ in
				let _fooS strcat "VALUE = " substr szParams pos1+1 strlen szParams -> _ in*/
				[substr szParams 0 pos1 substr szParams pos1+1 strlen szParams] :: nil;;
				

/*! \brief Return the params of a received GET request string.
*
* "http://domain.tld/dir/file.ext?param1=a&param2=b" -> "param1=a&param2=b"
*
* \ingroup std_net
* <b>Prototype :</b>fun [S] S
* 
* \param S : a valid request string
*
* \return S : the params or nil if not found
* \see std_netBuildListFromParams
*/
fun std_netGetParamsInUrl (szUrl)=
	if std_szIsEmpty szUrl then
		nil
	else
		let strfind "?" szUrl 0 -> pos in
		if pos == nil then
			nil
		else
			substr szUrl pos+1 strlen szUrl;;
	
fun std_netcheckcbconnection (szUrl, cbfun, iRes)=
	exec cbfun with [iRes];;
	
/*! \brief Check if a server can be joined
*
* \ingroup std_net
* <b>Prototype :</b>fun [S fun [I] I] I
* 
* \param S : an url to check
* \param fun [I] I : a function to call when the connection is checked.
* Its argument will be 1 if success.
*
* \return I : always 0
*/
fun std_netCheckConnection (szUrl, cbfun)=
	_rflINETisConnected szUrl @std_netcheckcbconnection cbfun;
	0;;