PureBasic Forums - English

Posted: **Wed Oct 19, 2011 4:49 pm**

Use "Thread-Safe" when compiling both the DLL and this program.

;------------ REST Interface

; Written by Justin Jack

; This will create your own REST server and implement your own REST-ful API that you can 
; call from a web browser.  The Methods in your DLL are threaded, so calls don't get backed 
; up from long-running processing, but this is very neat. You can embed calls to URLS to provide
; the functionality of PureBasic Procedures in your web-apps.  Just STOP the RESTInterface
; by holding CTRL-ALT-Q on the machine on which it's running, edit / re-compile your DLL
; and you're up-and-running! 



Global ThreadCount.i
Global RESTLibName.s = "C:\RESTAPI.dll"
Global ListeningPort = 80 ;- <-- Or Whatever

Procedure.s FormatSQL( text$ )
  text$ = ReplaceString(text$, "'", "''")
  text$ = ReplaceString(text$, "INSERT INTO", "")
  text$ = ReplaceString(text$, "DELETE FROM", "")
  ProcedureReturn text$
EndProcedure


;-----------------------------------------------------------------------------Functions

Procedure.s HTTPDate()
  Select DayOfWeek(Date())
          Case 0
            dow.s = "Sun, "
          Case 1
            dow.s = "Mon, "
          Case 2
            dow.s = "Tue, "
          Case 3
            dow.s = "Wed, "
          Case 4
            dow.s = "Thu, "
          Case 5
            dow.s = "Fri, "
          Case 6
            dow.s = "Sat, "
  EndSelect
  myDay.s =  Str(Day(Date()))
  If Len(myDay) = 1 : myDay = "0" + myDay : EndIf
  Select Month(Date())
          Case 1
            month.s = "Jan "
          Case 2
            month.s = "Feb " 
          Case 3
            month.s = "Mar "
          Case 4
            month.s = "Apr "
          Case 5
            month.s = "May "
          Case 6
            month.s = "Jun "
          Case 7
            month.s = "Jul "
          Case 8
            month.s = "Aug "
          Case 9
            month.s = "Sep "
          Case 10
            month.s = "Oct "
          Case 11
            month.s = "Nov "
          Case 12
            month.s = "Dec "
  EndSelect
  myYear.s = Str(Year(Date())) + " "
  myTime.s = FormatDate("%hh:%ii:%ss", AddDate(Date(), #PB_Date_Hour, -5))
  ProcedureReturn dow + myDay + " " + Month + myYear + myTime + " GMT"
EndProcedure

Procedure.s HttpError( ErrorText.s )
  ErrorMsg.s = "<html><h1>404 Bad Request</h1>"
  ErrorMsg.s + "<p>" + ErrorText + "</p>"
  ErrorMsg.s + "</html>"
  myResponse.s = "HTTP/1.1 404 Bad Request" + #CRLF$
  myResponse.s + "Date: " + HTTPDate() + #CRLF$
  myResponse.s + "Content-Type: text/html" + #CRLF$
  myResponse.s + "Content-Length: " + Str(Len(ErrorMsg.s)) + #CRLF$
  myResponse.s + "Connection: close"+ #CRLF$ + #CRLF$
  myResponse.s + ErrorMsg
  ProcedureReturn myResponse
EndProcedure




InitNetwork()

WebDllLib = OpenLibrary(#PB_Any, RESTLibName)
If Not(IsLibrary(WebDllLib))
  MessageBox_(#Null, @"Failed to open support library!", @"Initialization Error!", #MB_ICONERROR|#MB_OK)
  End -1
EndIf


CyberWebInterface = CreateNetworkServer(#PB_Any, ListeningPort, #PB_Network_TCP)
If Not(CyberWebInterface)
  MessageBox_(#Null, "Could not start REST Server!", "Network error port: " + Str(ListeningPort), #MB_ICONERROR|#MB_OK)
  End -1
EndIf

Structure ThreadCall
  FunctionName.s
  *ProcAddr
  *PassArgPtr
  *Connection
  *SecNumber
EndStructure

Structure cnList
  *Connection
  *SecNumber
EndStructure



Global nwConnectionMutex = CreateMutex()
Global NewList ConnectionList.cnList()

Procedure CloseNWConnection( *Connection, *SecNumber )
  LockMutex(nwConnectionMutex)
  ForEach ConnectionList()
    If ConnectionList()\Connection = *Connection And (ConnectionList()\SecNumber = *SecNumber Or *SecNumber = -1)
      If ConnectionList()\SecNumber = *SecNumber
        CloseNetworkConnection(ConnectionList()\Connection)
      EndIf
      DeleteElement(ConnectionList())
      Break
    EndIf
  Next
  UnlockMutex(nwConnectionMutex)
EndProcedure

Procedure LogNWConnection( *Connection, *SecNumber )
  LockMutex(nwConnectionMutex)
  AddElement(ConnectionList())
  ConnectionList()\Connection = *Connection
  ConnectionList()\SecNumber = *SecNumber
  UnlockMutex(nwConnectionMutex)
EndProcedure

Procedure GetSecNumber( *Connection )
  *SecNum = 0
  LockMutex(nwConnectionMutex)
  ForEach ConnectionList()
    If *Connection = ConnectionList()\Connection
      *SecNum = ConnectionList()\SecNumber
      Break
    EndIf
  Next
  UnlockMutex(nwConnectionMutex)
  ProcedureReturn *SecNum
EndProcedure



Procedure ProcessRequest( *tcInfo.ThreadCall )
  ThreadCount + 1
  RestRetVal = CallFunctionFast(*tcInfo\ProcAddr, *tcInfo\PassArgPtr)
  If RestRetVal = 0
    SendNetworkString(*tcInfo\Connection, HttpError("The call to the method: " + *tcInfo\FunctionName + " failed."))
  EndIf
  CloseNWConnection(*tcInfo\Connection, *tcInfo\SecNumber)
  *MiscPtr = 0
  UnitSize = SizeOf(*MiscPtr)
  If *tcInfo\PassArgPtr > 0
    ctr = 1
    *ptrToFree = PeekI(*tcInfo\PassArgPtr + (ctr * UnitSize))
    While *ptrToFree <> 0
      FreeMemory(*ptrToFree)
      ctr + 1
      *ptrToFree = PeekI(*tcInfo\PassArgPtr + (ctr * UnitSize))
    Wend
    FreeMemory(*tcInfo\PassArgPtr)
  EndIf
  FreeMemory(*tcInfo)
  ThreadCount - 1
  ProcedureReturn 0
EndProcedure



okToCloseRPCServer = 0
okToShutDown = 0
GetAsyncKeyState_(#VK_CONTROL)
GetAsyncKeyState_(#VK_MENU)
GetAsyncKeyState_(#VK_Q)

NewList myParameters.s()

*ReadBuffer = AllocateMemory(2000)
Repeat 
  nsEvent = NetworkServerEvent()
  Select nsEvent
    Case 0
      Delay(20)
    Case #PB_NetworkEvent_Connect
      LogNWConnection(EventClient(), Random(2000000))
    Case #PB_NetworkEvent_Disconnect
      CloseNWConnection(EventClient(), -1)
    Case #PB_NetworkEvent_Data
      ThisRead = 0
      httpRequest.s = ""
      myResponse.s = ""
      DropPacket = 0
      *eClient = EventClient()
      *LocalSecNumber = GetSecNumber(*eClient)
      If *LocalSecNumber <> 0
        dwBytes = ReceiveNetworkData(*eClient, *ReadBuffer, 2000)
        If dwBytes > 0
          ThisRead + dwBytes
          If dwBytes > 0
            httpRequest + PeekS(*ReadBuffer, dwBytes)
            While dwBytes > 0
              dwBytes = ReceiveNetworkData(*eClient, *ReadBuffer, 2000)
              ThisRead + dwBytes
              If (dwBytes > 0) And ThisRead < 2000
                httpRequest + PeekS(*ReadBuffer, dwBytes)
              Else
                If ThisRead >= 2000
                  ; Send 404 Bad Request
                  ErrorMsg.s = "<html><h1>404 Bad Request</h1>"
                  ErrorMsg.s + "<p>The size of data received was: " + Str(ThisRead) + "</p>"
                  ErrorMsg.s + "</html>"
                  myResponse.s = "HTTP/1.1 404 Bad Request" + #CRLF$
                  myResponse.s + "Date: " + HTTPDate() + #CRLF$
                  myResponse.s + "Content-Type: text/html" + #CRLF$
                  myResponse.s + "Content-Length: " + Str(Len(ErrorMsg.s)) + #CRLF$
                  myResponse.s + "Connection: close"+ #CRLF$ + #CRLF$
                  myResponse.s + ErrorMsg
                  SendNetworkString(*eClient, myResponse)
                  CloseNWConnection(*eClient, *LocalSecNumber)
                  DropPacket = 1
                  Break
                EndIf
              EndIf
            Wend
          EndIf
        Else
          ErrorMsg.s = "<html><h1>404 Bad Request</h1>"
          ErrorMsg.s + "<p>No Data Rec'd, chump.</p>"
          ErrorMsg.s + "</html>"
          myResponse.s = "HTTP/1.1 404 Bad Request" + #CRLF$
          myResponse.s + "Date: " + HTTPDate() + #CRLF$
          myResponse.s + "Content-Type: text/html" + #CRLF$
          myResponse.s + "Content-Length: " + Str(Len(ErrorMsg.s)) + #CRLF$
          myResponse.s + "Connection: close"+ #CRLF$ + #CRLF$
          myResponse.s + ErrorMsg
          SendNetworkString(*eClient, myResponse)
          CloseNWConnection(*eClient, *LocalSecNumber)
          DropPacket = 1
        
        EndIf
        If DropPacket = 0 ; Parse and validate request here!
          isChunked = 0
          MethodToCall.s = ""
          HttpMethod.s = ""
          MethodLine.s = ""
          ClearList(myParameters())
          ResponseMessage.s = "" ; Xml Response Here
          numHttpLines = CountString(httpRequest, #LF$)
          ErrorSent = 0
          httpLine.s = ""
          tempLine.s = ""
          Parameters.s = ""
          For i = 1 To numHttpLines
            tempLine.s = StringField(httpRequest, i, #LF$) 
            httpLine.s = Left(tempLine, Len(tempLine) - 1)
            If i = 1 ; Check the 1st line for the HTTP Method
              HttpMethod.s = UCase(StringField(httpLine, 1, " "))
              If HttpMethod.s  = "GET"
                MethodLine2.s  = StringField(httpLine, 2, "/")
                MethodLine1.s  = URLDecoder(StringField(MethodLine2, 1, " "))
                MethodToCall.s = UCase(StringField(MethodLine1, 1, "?"))
                Parameters.s   = Right(MethodLine1, Len(MethodLine1) - (Len(MethodToCall) + 1))
                If Parameters <> ""
                  numParams = CountString(Parameters, "&") + 1
                  For ii = 1 To numParams
                   AddElement(myParameters())
                   myParameters() = StringField(Parameters, ii, "&")
                  Next
                  AddElement(myParameters())
                  myParameters() = ""
                EndIf
                If Not(IsLibrary(WebDllLib))
                  SendNetworkString(*eClient, HttpError("Could not load Method Library!"))
                  CloseNWConnection(*eClient, *LocalSecNumber)
                  ErrorSent = 1
                  Break
                EndIf
              
                If Not(ExamineLibraryFunctions(WebDllLib))
                  SendNetworkString(*eClient, HttpError("No Exposed Methods Found!"))
                  CloseNWConnection(*eClient, *LocalSecNumber)
                  ErrorSent = 1
                Else
                  Found = 0
                  *fAddress = 0
                  While NextLibraryFunction()
                    lfName.s = LibraryFunctionName()
                    If UCase(lfName) = MethodToCall
                      fName.s = LibraryFunctionName()
                      *fAddress = LibraryFunctionAddress()
                      Found = 1
                      Break
                    EndIf
                  Wend
                
                  If Found = 0 And ErrorSent = 0
                    SendNetworkString(*eClient, HttpError("Requested Method Not Found!"))
                    CloseNWConnection(*eClient, *LocalSecNumber)
                    ErrorSent = 1
                  ElseIf ErrorSent = 0
                    ; Call Method Here
                    numberOfArgs.i = ListSize(myParameters())
                    *ArgPtr = 0
                    UnitSize = SizeOf(*ArgPtr)
                    *ArgPtr = AllocateMemory( ((numberOfArgs+2) * UnitSize) + 10    ) 
                    PokeI(*ArgPtr, *eClient)
                    If numberOfArgs > 0
                      ctr = 1
                      ResetList(myParameters())
                      While NextElement( myParameters() )
                        offsetSpace = (8 - Len(myParameters()) % 8)
                        *StringSpot = AllocateMemory(Len(myParameters()) + 255)
                        PokeS(*StringSpot, myParameters())
                        PokeI(*ArgPtr + (ctr * UnitSize), *StringSpot )
                        ctr + 1
                      Wend
                      PokeI(*ArgPtr + (ctr * UnitSize), 0)
                    EndIf
                    If *ArgPtr > 0
                      *tcInfo.ThreadCall = AllocateMemory(SizeOf(ThreadCall))
                      *tcInfo\FunctionName = fName
                      *tcInfo\PassArgPtr = *ArgPtr
                      *tcInfo\Connection = *eClient
                      *tcInfo\ProcAddr = *fAddress
                      *tcInfo\SecNumber = *LocalSecNumber
                      CreateThread(@ProcessRequest(), *tcInfo)
                      MethodRun = 1
                    EndIf
                  EndIf
                EndIf
                Break
              Else
                SendNetworkString(*eClient, HttpError("Invalid HTTP Method <p>Only GET is supported</p>"))
                CloseNWConnection(*eClient, *LocalSecNumber)
                ErrorSent = 1
                Break
              EndIf
            EndIf
          Next
          If ErrorSent = 0 And MethodRun = 0
            myResponse.s = "HTTP/1.1 200 OK" + #CRLF$
            myResponse.s + "Date: " + HTTPDate() + #CRLF$
            If FindString(ResponseMessage, "xml", 1) > 0
              myResponse.s + "Content-Type: text/xml" + #CRLF$
            Else
              myResponse.s + "Content-Type: text/html" + #CRLF$
            EndIf
            myResponse.s + "Content-Length: " + Str(Len(ResponseMessage.s)) + #CRLF$
            myResponse.s + "Connection: close"+ #CRLF$ + #CRLF$
            myResponse.s + ResponseMessage
            SendNetworkString(*eClient, myResponse)
            CloseNWConnection(*eClient, *LocalSecNumber)
          EndIf
        EndIf
      EndIf
  EndSelect
  okToCloseRPCServer = ((GetAsyncKeyState_(#VK_CONTROL) & GetAsyncKeyState_(#VK_MENU)) & GetAsyncKeyState_(#VK_Q)) * -1
  If okToCloseRPCServer <> 0
    okToShutDown = 1
  EndIf
Until okToShutDown = 1
 If IsLibrary(WebDllLib)
   CloseLibrary(WebDllLib )
 EndIf
CloseNetworkServer(CyberWebInterface)
MessageBox_(GetActiveWindow_(), @"REST Server Shut Down!", @"Notice!", #MB_OK)
End 1

Posted: **Wed Oct 19, 2011 4:50 pm**

Here's the code to start the DLL, I put a few sample Web-Methods.
Remember: COMPILE THIS AS A DLL, AND USE "THREAD-SAFE"

Code: Select all

; REST Methods
;- Enumerations----------------------






;- Structures------------------------

;- Internal Private Procedures -----


Procedure GetArgPtr( *ArgPtrDLL, ArgNumber )
  If *ArgPtrDLL = 0
    ProcedureReturn 0
  EndIf
  ProcedureReturn PeekI(*ArgPtrDLL + (ArgNumber * SizeOf(*ArgPtrDLL)))
EndProcedure


Procedure.s MakeCDATA( myString.s )
  ProcedureReturn "<![CDATA[" + myString + "]]>"
EndProcedure


Procedure.s FormatSQL( text$ )
  text$ = ReplaceString(text$, "'", "''")
  text$ = ReplaceString(text$, "DELETE FROM", "")
  text$ = ReplaceString(text$, "INSERT INTO", "")
  ProcedureReturn text$
EndProcedure


Procedure.s FormatReturnXML( iCode.i, Msg.s, MethodCalled.s, myXml.s )
  retString.s = "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding="+Chr(34)+"UTF-8"+Chr(34)+" ?>"
  retString.s + "<ResponseMessage>"
  retString.s + "<MethodCalled>"+ MethodCalled.s + "</MethodCalled>"
  retString.s + "<Code>" + Str(iCode) + "</Code>"
  retString.s + "<Message>" + Msg + "</Message>" + myXml
  retString.s + "</ResponseMessage>"
  ProcedureReturn retString
EndProcedure






;- Put your Procedures HERE! ----


ProcedureDLL WebMethodTest( *ArgPtrDLL ) ;-Web Method WebMethodTest
  retVal = 0
  argCtr = 0
  NewList Arguments.s()
  
  ;- This will fetch your argument list
  ;  and put them into the list: Arguments()
  
  *aPtr = GetArgPtr( *ArgPtrDLL, argCtr ) 
  If *aPtr <> 0
    *eClient = *aPtr
    argCtr + 1
  Else
    retVal = -1 ;- Here we have some connection problem, so we're not returning 0
    ProcedureReturn retVal
  EndIf
  While *aPtr <> 0
    *aPtr = GetArgPtr( *ArgPtrDLL, argCtr ) 
    If *aPtr <> 0
      AddElement(Arguments())
      Arguments() = PeekS(*aPtr)
      argCtr + 1
    EndIf
  Wend
  
  
  ;- Now do whatever...
  
  
  retVal = #True ;<- return TRUE if the procedure succeeded, to tell the ProcessRequest()
                 ;   procedure we took care of responding, other-wise if you return FALSE,
                 ;   when this procedure exits, the calling procedure will return an 
                 ;   HTTP Error.
                 
                 
  If ListSize(Arguments()) > 0
    
    ;- Put together your XML response here..
    myXML.s = "<Arguments_Passed>"
    ForEach Arguments()
      myXML.s + "<Argument>" + MakeCDATA(Arguments()) + "</Argument>"
    Next
    myXML.s + "</Arguments_Passed>"
    
    StringToSend.s = FormatReturnXML(1, "Test Successful!", "WebMethodTest", myXML)
    
    SendNetworkString(*eClient, StringToSend)
  Else
    myXML.s = "<How_To_Call>" + MakeCDATA("  Format: http://URL:PORT/MethodName?Arg1&Arg2&Arg3...") + "</How_To_Call>"
    
    StringToSend.s = FormatReturnXML(0, "Method Called without Arguments.", "WebMethodTest", myXML)
    
    SendNetworkString(*eClient, StringToSend)
  EndIf
  
  FreeList(Arguments())
  ProcedureReturn retVal
  
EndProcedure



ProcedureDLL DivideNumbers( *ArgPtrDLL ) ;- Web Method "DivideNumbers"
  retVal = 0
  argCtr = 0
  NewList Arguments.s()
  *aPtr = GetArgPtr( *ArgPtrDLL, argCtr ) 
  If *aPtr <> 0
    *eClient = *aPtr
    argCtr + 1
  Else
    retVal = -1 
    ProcedureReturn retVal
  EndIf
  While *aPtr <> 0
    *aPtr = GetArgPtr( *ArgPtrDLL, argCtr ) 
    If *aPtr <> 0
      AddElement(Arguments())
      Arguments() = PeekS(*aPtr)
      argCtr + 1
    EndIf
  Wend
  argCtr = 0
  ForEach Arguments()
    Select argCtr
      Case 0
        numerator.f = ValF(Arguments())
      Case 1
        denominator.f = ValF(Arguments())
    EndSelect
    argCtr + 1
  Next
  If denominator > 0
    myXml.s = "<MathProblem>" + StrF(numerator, 3) + "/"  + StrF(denominator, 3) + "</MathProblem>"
    myXml.s + "<Answer>" + StrF(numerator / denominator, 3) + "</Answer>"
    SendNetworkString(*eClient, FormatReturnXML(1, "Success!", "DivideNumbers", myXml))
  Else
    myXml.s = "<MathProblem>" + StrF(numerator, 3) + "/"  + StrF(denominator, 3) + "</MathProblem>"
    myXml.s + "<Answer></Answer>"
    SendNetworkString(*eClient, FormatReturnXML(-1, "Division By Zero", "DivideNumbers", myXml))
  EndIf
  FreeList(Arguments())
  ProcedureReturn #True
  
EndProcedure

Posted: **Wed Oct 19, 2011 4:58 pm**

You can test these out to see how they work here:
http://65.41.75.148:3142/WebMethodTest?This&Is&A&Test/

http://65.41.75.148:3142/WebMethodTest/

http://65.41.75.148:3142/DivideNumbers?267&12/

http://65.41.75.148:3142/DivideNumbers?267/

**LINKS DISABLED, I'M USING THAT PORT FOR SOMETHING ELSE NOW..

Posted: **Wed Oct 19, 2011 9:02 pm**

thanks!

PureBasic Forums - English

Have your own REST-Api Server!

Have your own REST-Api Server!

Re: Have your own REST-Api Server!

Re: Have your own REST-Api Server!

Re: Have your own REST-Api Server!