bliss/http.bi

' http.bi is part of Bliss (track editor for Stunts)
' Copyright (C) 2016-2018  Lucas Pedrosa

' Bliss is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, version 3 of the License.

' 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 General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program.  If not, see <http://www.gnu.org/licenses/>.


#ifdef __FB_WIN32__
	#include "windows.bi"
	#include "win/windef.bi"
	#include "win/winsock2.bi"
	#ifndef opensocket
	#define opensocket socket
	#endif
#else
	#include "crt/unistd.bi"
	#include "crt/netinet/in.bi"
	#include "crt/sys/select.bi"
	#include "crt/netdb.bi"
	#include "crt/arpa/inet.bi"
#endif

#ifndef TCP_NODELAY
	#define TCP_NODELAY &H01
#endif

Declare Sub HTTP_Start
Declare Sub HTTP_End
Declare Function HTTP_StartServer(ByVal port As UShort, max_connections As Integer) As Byte
Declare Function HTTP_GetClient As Long
Declare Function HTTP_Connect(address As String, port As UShort) As Byte
Declare Function HTTP_BuildGet(host As String, path As String, mimetype As String = "") As String
Declare Function HTTP_BuildHead(host As String, path As String, mimetype As String = "") As String
Declare Function HTTP_BuildPost(host As String, path As String, query As String, refer As Byte) As String
Declare Function HTTP_ReadyToGet As Byte
Declare Function HTTP_ReadyToPut As Byte
Declare Function HTTP_GetData(ByRef dbuffer As Any Ptr) As Long
Declare Function HTTP_PutData(ByVal dbuffer As Any Ptr, ByVal datasize As Long) As Long

Dim Shared HTTP_Socket As Long, HTTP_addr As sockaddr_in
Dim Shared As fd_set HTTP_writefds, HTTP_readfds, HTTP_readfd
Dim Shared HTTP_timeout As timeval
Dim Shared use_curl As Byte = -1


Function HTTP_BuildGet(host As String, path As String, mimetype As String = "") As String
	Dim s As String
	
	s = "GET " + path + " HTTP/1.1" + Chr(13, 10)
	s += "Host: " + host + Chr(13, 10)
	If Len(mimetype) Then s += "mime: " + mimetype + Chr(13, 10)
	s += Chr(13, 10)
	
	Return s
End Function


Function HTTP_BuildHead(host As String, path As String, mimetype As String = "") As String
	Dim s As String
	
	s = "HEAD " + path + " HTTP/1.1" + Chr(13, 10)
	s += "Host: " + host + Chr(13, 10)
	If Len(mimetype) Then s += "mime: " + mimetype + Chr(13, 10)
	s += Chr(13, 10)
	
	Return s
End Function


Function HTTP_BuildPost(host As String, path As String, query As String, refer As Byte) As String
	Dim s As String
	
	s = "POST " + path + " HTTP/1.1" + Chr(13, 10)
	s += "Host: " + host + Chr(13, 10)
	
	If refer Then s += "Referer: http://" + host + path + "?" + Chr(13, 10)
	s += "Content-type: application/x-www-form-urlencoded" + Chr(13, 10)
	s += "Content-length: " + Str(Len(query)) + Chr(13, 10)
	s += "Connection: close" + Chr(13, 10, 13, 10)
	s += query
	
	Return s
End Function


Function HTTP_Connect(address As String, port As UShort) As Byte
	HTTP_Start
	HTTP_Socket = opensocket(AF_INET, SOCK_STREAM, 0)
	
	If HTTP_Socket = -1 Then Return -1
	
	Dim he As hostent Ptr
	he = gethostbyname(StrPtr(address))
	If he = 0 Then Return -2
	
	HTTP_addr.sin_family = AF_INET
	HTTP_addr.sin_port = htons(port)
	HTTP_addr.sin_addr = *CPtr(in_addr Ptr, he->h_addr_list[0])
	If connect(HTTP_Socket, CPtr(sockaddr Ptr, @HTTP_addr), SizeOf(sockaddr)) < 0 Then
		Return -3
	End if
	
	Return 0
End Function


Function HTTP_Download_via_curl(address As String, ByRef buffer As UByte Ptr, isawebpage As Byte = 0, tempdir As String = "") As Long
	Dim ad As String, f As Integer
	
	ad = Trim(address)
	If LCase(Left(ad, 5)) = "http:" OrElse LCase(Left(ad, 6)) = "https:" Then
		Shell "curl --connect-timeout 8 " & ad & " > " & tempdir & "tfile.tmp"
	Else
		Shell "curl --connect-timeout 8 https://" & ad & " > " & tempdir & "tfile.tmp"
		If FileLen(tempdir & "tfile.tmp") = 0 Then
			Shell "curl --connect-timeout 10 http://" & ad & " > " & tempdir & "tfile.tmp"
		End If
	End If
	
	If FileLen(tempdir & "tfile.tmp") = 0 Then
		Return 0
	Else
		Dim l As Long
		
		f = FreeFile
		Open tempdir & "tfile.tmp" For Binary Access Read As f
		l = LoF(f)
		If buffer Then Deallocate buffer : buffer = 0
		buffer = Allocate(LoF(f))
		Get #f, , *buffer, LoF(f)
		Close f
		Kill tempdir & "tfile.tmp"
		Return l
	End If
End Function


Function HTTP_Download(address As String, ByRef buffer As UByte Ptr, isawebpage As Byte = 0, tempdir As String = "") As Long
	If use_curl Then
		Return HTTP_Download_via_curl(address, buffer, isawebpage, tempdir)
	End If
	
	Dim request As String, n As Short
	Dim As String host, path, mime
	Dim t As Double, bytes As Long, newbuffer As UByte Ptr
	Dim header As ZString Ptr

	If isawebpage Then mime = "text/html;text/plain" Else mime = ""
	
	n = InStr(address, "/")
	If n Then
		host = Left(address, n - 1)
		path = Mid(address, n)
	Else
		host = address
		path = "/"
	End If
	
	If HTTP_Connect(host, 80) Then Return -1	'Could not connect

	request = HTTP_BuildGet(host, path, mime)
	t = Timer
	Do
		If HTTP_ReadyToPut Then Exit Do
		If Timer > t + 3 Then Return -2		'Time-out 3 seconds
		Sleep 100
	Loop
	
	HTTP_PutData StrPtr(request), Len(request)

	t = Timer
	Do
		If HTTP_ReadyToGet Then Exit Do
		If Timer > t + 3 Then Return -3		'Time-out 3 seconds
		Sleep 100
	Loop

	bytes = HTTP_GetData(newbuffer)
	header = newbuffer
	n = InStr(*header, Chr(13, 10, 13, 10)) + 3
	
	If buffer Then Deallocate buffer : buffer = 0
	If bytes - n >= 1 Then
		buffer = Allocate(bytes - n)
		For i As Long = 0 To bytes - n - 1
			buffer[i] = newbuffer[i + n]
		Next i
	End If

	Deallocate newbuffer

	Return bytes - n
End Function


Sub HTTP_End
	If HTTP_Socket >= 1 Then closesocket(HTTP_Socket)
	#ifdef __FB_WIN32__
		WSACleanup()
	#endif
End Sub


Function HTTP_GetData(ByRef dbuffer As Any Ptr) As Long
	Static chunk(8191) As UByte
	
	If HTTP_Socket < 0 Then Return -1
	
	Dim dsize As Long, bytes As Long, pwrite As UByte Ptr, i As Long
	
	If dbuffer Then Deallocate dbuffer : dbuffer = 0
	Do
		bytes = recv(HTTP_Socket, @chunk(0), 8192, 0)
		
		If bytes = 0 Then
			If dsize = 0 Then Return -1
			Exit Do
		End If
		If bytes < 0 Then Return -1
		
		dbuffer = Reallocate(dbuffer, dsize + bytes)
		pwrite = dbuffer + dsize
		
		For i = 0 To bytes - 1
			pwrite[i] = chunk(i)
		Next i
		dsize += bytes
		
		Sleep 20
		For i = 1 To 100
			If HTTP_ReadyToGet Then Exit For
			Sleep 10
		Next i
	Loop Until i > 100
	
	Return dsize
End Function


Function HTTP_PutData(ByVal dbuffer As Any Ptr, ByVal datasize As Long) As Long
	If HTTP_Socket < 0 Or dbuffer = 0 Or datasize < 1 Then Return -1
	
	Dim size As Long, dsize As Integer, bytes As Long
	
	dsize = datasize
	While (size < datasize)
		bytes = send(HTTP_Socket, dbuffer, dsize, 0)
		If bytes < 0 Then Return -1
		dbuffer += bytes
		dsize -= bytes
		size += bytes
	WEnd
	
	Return size
End Function


Function HTTP_ReadyToGet As Byte
	If HTTP_Socket < 0 Then Return -1
	
	FD_ZERO(@HTTP_readfds)
	FD_SET_(HTTP_Socket, @HTTP_readfds)
	If select_(HTTP_Socket + 1, @HTTP_readfds, 0, 0, @HTTP_timeout) = -1 Then Return -1
	
	Return IIf(FD_ISSET(HTTP_Socket, @HTTP_readfds), -1, 0)
End Function


Function HTTP_ReadyToPut As Byte
	If HTTP_Socket < 0 Then Return -1
	
	FD_ZERO(@HTTP_writefds)
	FD_SET_(HTTP_Socket, @HTTP_writefds)
	If select_(HTTP_Socket + 1, 0, @HTTP_writefds, 0, @HTTP_timeout) = -1 Then Return -1
	
	Return IIf(FD_ISSET(HTTP_Socket, @HTTP_writefds), -1, 0)
End Function


Sub HTTP_Start
	Static already_initialised As Byte = 0

	#ifdef __FB_WIN32__
		If Not already_initialised Then
			Dim wdata As WSAData

			WSAStartup(WINSOCK_VERSION, @wdata)
			already_initialised = -1
		End If
	#endif
End Sub


Function HTTP_GetClient As Long
	Dim ip As Long
	
	FD_ZERO(@HTTP_readfd)
	FD_SET_(HTTP_Socket, @HTTP_readfd)
	
	If select_(HTTP_Socket + 1, @HTTP_readfd, 0, 0, @HTTP_timeout) = -1 _
		Then Return 0
		
	If FD_ISSET(HTTP_Socket, @HTTP_readfd) Then
		ip = accept(HTTP_Socket, 0, 0)
		If ip = -1 Then	Return 0
		Return ip
	Else
		Return 0
	End If
End Function