PureBasic Forums - English

Code: Select all

    ; Copyright: AND51, 2009
    ; Contact: AND51 at purebasic.fr/english
    ; E-Mail: purebasic@and51.de
    ;       You may use this app, there is no special licence.
    ;       Just make me happy by putting me into your credits
    ;    Note: We must circumvent a bug in ProgramRunning() (see lines 142 and 233) (only on Linux without debugger).

    ; inform child processes, such as the PB-scripts, about this programs version
    SetEnvironmentVariable("PB_Interpreter_Version", "150")

    ; to show that we have good manners :-)
    EnableExplicit

    ; for later usage, measures the time needed for whole compilation
    Define creation_time=ElapsedMilliseconds()

    ; open console for apache (this is our stdout)
    If Not OpenConsole()
       End
    EndIf

    ; collect program parameters to pass them to the purebasic-executable later on.
    ; you can define program parameters in the shebang-line. example:
    ; #!/purebasic/interpreter -param1 -w /fast
    ; these params are passed to this interpreter and we forward them to the pb-executable.
    ; some parameters are also relevant for the behaviour of this interpreter.
    ; on my linux server, all parameters are passed as one parameter, so we only catch param number one!
    Define commandline$=RemoveString(RemoveString(ProgramParameter(0), #LF$), #CR$), i, n
    NewList parameters.s()
    If commandline$
       n=CountString(commandline$, " ")+1
       For i=1 To n
          AddElement(parameters())
             parameters()=StringField(commandline$, i, " ")
       Next
    EndIf

    Procedure isParameter(parameter$)
       ; returns 0 unless the specified parameter was passed to this interpreter
       Shared parameters()
       ForEach parameters()
          If parameters() = parameter$
             ProcedureReturn 1
          EndIf
       Next
    EndProcedure
    Procedure.s getParameterValue(parameter$)
       ; returns the value of a specified parameter. so if there os a param like /number=51,
       ; you weill get 51, if you pass "/number" here (colons (:) and equals (=) are valid delimiters)
       Shared parameters()
       Protected length=Len(parameter$)
       ForEach parameters()
          If Left(parameters(), length) = parameter$
             Protected delimiter=FindString(parameters(), ":", 1)
             If Not delimiter
                delimiter=FindString(parameters(), "=", 1)
             EndIf
             If delimiter
                ProcedureReturn Mid(parameters(), delimiter+1)
             EndIf
          EndIf
       Next
    EndProcedure
    Procedure error(ErrorDescription$, stdout=0)
       ; outputs userdefined error to stderr and exits
       ; if 'stdout' is true or parameter -w was passed, then write it to stdout, too
       ; (including prepending http-header)
       ConsoleError(ErrorDescription$)
       If stdout Or isparameter("-w") Or isParameter("--warn")
          PrintN("Content-Type: text/html"+#LF$)
          PrintN(ErrorDescription$)
       EndIf
       End
    EndProcedure
    Procedure FindLastString(String$, StringToFind$, CaseInSensitive=0)
       Protected length=Len(StringToFind$), *position=@String$+(Len(String$)-length)<<#PB_Compiler_Unicode
       If StringToFind$
          While *position >= @String$
             If CompareMemoryString(*position, @StringToFind$, CaseInSensitive, length) = #PB_String_Equal
                ProcedureReturn (*position-@String$)>>#PB_Compiler_Unicode+1
             EndIf
             *position-SizeOf(Character)
          Wend
       EndIf
    EndProcedure

    ; apache sets an environment variable, named SCRIPT_FILENAME. this is the pb-file we
    ; have to compile. if this var is missing, our job is invalid and we can
    Define script_filename$=GetEnvironmentVariable("SCRIPT_FILENAME")
    If FileSize(script_filename$) = -1
       error("The environmentvariable SCRIPT_FILENAME contains an invalid or no filename: "+script_filename$)
    EndIf

    ; set neccessary environment-variables for the compiler, so you do not need 'export'.
    ; yes, this interpreter is self-configuring ;-)
    ; to get this working properly, place this interpreter in the root directory of purebasic (not in the
    ; 'compilers' directory!)
    SetEnvironmentVariable("PUREBASIC_HOME", GetPathPart(ProgramFilename()))
    ;SetEnvironmentVariable("PATH", GetEnvironmentVariable("PUREBASIC_HOME")+"compilers:"+GetEnvironmentVariable("PATH"))

    ; generate unique filename for the executable source code in this format:
    ; %TempDir%/pb-executbale_PathAndFilenameOfSourceWithoutSlash
    Define source$, exe$=GetTemporaryDirectory()+"pb-executable_"+RemoveString(script_filename$, "/")

    ; new compilation system: filenames are not random any more, but still unique (see line 88-90).
    ; we only have to compile again, if the source code has changed since the last compilation.
    ; if the executable already exists, we only have to run it. this saves time and disk space: one
    ; executable can be run by different users. the exe will remain in the temporary directory, however.
    ; to delete the exe nevertheless after usage, use the -f (f=force recompile) parameter. in this case the
    ; exe-filename is appended some random numbers to get a unique filename (to avoid conflicts when
    ; two users create the same exe with the same filename, whereas the user finishing firstly wants
    ; to delete the executable used by a second user)
    If isParameter("-f") Or isParameter("--force")
       exe$+FormatDate("_%yyyy-%mm-%dd_%hh-%ii-%ss_CanBeDeleted_", Date())+Str(Random(9999999))+".tmp"
       SetEnvironmentVariable("PB_Interpreter_ParamForce", "1")
    EndIf

    ; test, if (re-)compilation is neccessary or was enforced
    If GetFileDate(script_filename$, #PB_Date_Modified) > GetFileDate(exe$, #PB_Date_Created)
       ; generate a filename for the copy of the source code. it mus be unicq also, but will be deleted afterwards
       source$=exe$+".pb"
       
       ; in this section we copy the source file to leave the original source untouched. we edit the copy and send it
       ; to the compiler. first, we parse the file (if the specified parameters are set), then we comment the shebang-line.
       ; important: we need to filter the shebang-line, otherwise this would cause a syntax error.
       ; fastest method: copy it and comment the first line. (so the first line is always considered to be non-PB code!)
       ; if you know a faster method, please tell me (AND51 @ PB-forums)
       If isParameter("-p") Or isParameter("--parse") ; copying and parsing (if params are set)
          Define script=ReadFile(#PB_Any, script_filename$)
          If script
             Define tempfile=CreateFile(#PB_Any, source$)
             If tempfile
                Define parsing_mode$, n, line$, bom=ReadStringFormat(script)
                WriteStringFormat(tempfile, bom)
                WriteStringN(tempfile, ";"+ReadString(script, bom), bom)
                Define here_start=CreateRegularExpression(#PB_Any, "(?i)<<(|here|include|file|file|multi(|line)|(cr|)lf)$", #PB_RegularExpression_AnyNewLine|#PB_RegularExpression_MultiLine)
                Define here_end=CreateRegularExpression(#PB_Any, "^\s*<<", #PB_RegularExpression_AnyNewLine|#PB_RegularExpression_MultiLine)
                While Not Eof(script)
                   line$=ReadString(script, bom)
                   If MatchRegularExpression(here_start, line$)
                      n=FindLastString(line$, "<<")
                      WriteString(tempfile, Left(line$, n-1), bom) ; user should care about #DQUOTE$ by himself
                      parsing_mode$=LCase(Mid(line$, n+2))
                      Print(">>"+parsing_mode$)
                      Select parsing_mode$
                         Case "include", "file" ; include an external file and treat it as one string, i. e. replacing (cr)lf's
                            While Not Eof(script)
                               line$=ReadString(script, bom)
                               If MatchRegularExpression(here_end, line$)
                                  Break
                               Else
                                  Print(">>"+GetPathPart(script_filename$)+Trim(line$))
                                  Define include=ReadFile(#PB_Any, GetPathPart(script_filename$)+Trim(line$)), temp$
                                  Print(">>"+Str(include))
                                  If include
                                     Define include_bom=ReadStringFormat(include)
                                     While Not Eof(include)
                                        WriteString(tempfile, ReadString(include, include_bom), bom)
                                        If Not Eof(include)
                                           CompilerIf #PB_Compiler_OS = #PB_OS_Windows
                                              WriteString(tempfile, #DQUOTE$+"+#CRLF$+"+#DQUOTE$, bom)
                                           CompilerElse
                                              WriteString(tempfile, #DQUOTE$+"+#LF$+"+#DQUOTE$, bom)
                                           CompilerEndIf
                                        EndIf
                                     Wend
                                     CloseFile(include)
                                  Else
                                     error("Could not open '"+line$+"' as include file.")
                                  EndIf
                               EndIf
                            Wend
                         Case "crlf", "lf", "multiline", "multi", "here" ; normal HERE-document (like in perl) with crlf-replacement
                            While Not Eof(script)
                               line$=ReadString(script, bom)
                               If MatchRegularExpression(here_end, line$)
                                  Break
                               Else
                                  Select parsing_mode$
                                     Case "crlf"
                                        WriteString(tempfile, #DQUOTE$+"+#CRLF$+"+#DQUOTE$, bom)
                                     Case "lf"
                                        WriteString(tempfile, #DQUOTE$+"+#LF$+"+#DQUOTE$, bom)
                                     Default
                                        CompilerIf #PB_Compiler_OS = #PB_OS_Windows
                                           WriteString(tempfile, #DQUOTE$+"+#CRLF$+"+#DQUOTE$, bom)
                                        CompilerElse
                                           WriteString(tempfile, #DQUOTE$+"+#LF$+"+#DQUOTE$, bom)
                                        CompilerEndIf
                                  EndSelect
                               EndIf
                               WriteString(tempfile, line$, bom)
                            Wend
                         Default
                            While Not Eof(script)
                               line$=ReadString(script, bom)
                               If MatchRegularExpression(here_end, line$)
                                  Break
                               EndIf
                               WriteString(tempfile, line$, bom)
                            Wend
                      EndSelect
                      WriteStringN(tempfile, Mid(line$, FindString(line$, "<<", 1)+2), bom) ; #DQUOTE$ user should care for dquotes by himself
                   Else
                      WriteStringN(tempfile, line$, bom)
                   EndIf
                Wend
                CloseFile(script)
                CloseFile(tempfile)
             Else
                error("The source file cannot be created.")
             EndIf
          Else
             error("The source file cannot be read for parsing.")
          EndIf
       Else ; copying only (editing only first line)
          If CopyFile(script_filename$, source$)
             Define tempfile=OpenFile(#PB_Any, source$)
             If tempfile
                WriteString(tempfile, ";", ReadStringFormat(tempfile))
                CloseFile(tempfile)
             Else
                error("Temporary source file cannot be edited.")
             EndIf
          Else
             error("Source file cannot be copied.")
          EndIf
       EndIf
       
       ; timeout granted for compilation: 5 seconds (suggestion only!)
       Define compilation_time=ElapsedMilliseconds()
       
       ; compile the requested executable to the temp-folder, not to the same directory as the source code.
       ; --quiet disables all unneccessary text output; so there will only be text ouput, if a compiler error
       ; occured. so if AvailableProgramOutput() is zero, compilation was successful
       Define compiler=RunProgram(GetPathPart(ProgramFilename())+"compilers/pbcompiler", "--quiet --executable "+#DQUOTE$+exe$+#DQUOTE$+" "+#DQUOTE$+source$+#DQUOTE$, "", #PB_Program_Open|#PB_Program_Read)
       If Not compiler
          error("Compiler could not be started.")
       EndIf
       
       ; waiting if neccessary and catch the compilers output; if output > 0, then there is an error.
       ; we assume this, because of the --quiet flag (see line 125-128).
       ; kill the compiler and abort the whole procress, if timeout reached
       WaitProgram(compiler, 5000)
       Define compilerOutput=AvailableProgramOutput(compiler)
       
       If compilerOutput Or FileSize(exe$) = -1 Or ElapsedMilliseconds() > compilation_time+5000 ;Or ProgramRunning(compiler)
          Define compiler_error$, *compiler=AllocateMemory(compilerOutput)
          If *compiler
             ReadProgramData(compiler, *compiler, compilerOutput)
             compiler_error$=PeekS(*compiler)
          Else
             compiler_error$=ReadProgramString(compiler)+" (this was probably not the whole compiler output due to technical reasons)"
          EndIf
          CloseProgram(compiler)
          KillProgram(compiler)
          error("Compilation process did not finish correctly. Error: "+#DQUOTE$+compiler_error$+#DQUOTE$+".")
       EndIf
       
       ; new: compress the executable with UPX when you specify the parameter -c. as this step is optional, interpreter
       ; will continue in any case, even if the executable was not compressed (for whatever reason). furthermore, files
       ; seem to not be compressed, when they are too small anyway. we will use UPX's standard settings, as they
       ; offer a good balance between speed and compression ratio
       If isParameter("-c") Or isParameter("--compress")
          If Not RunProgram(GetPathPart(ProgramFilename())+"upx", "-qqq "+#DQUOTE$+exe$+#DQUOTE$, "", #PB_Program_Wait)
             ConsoleError("Something went wrong when compressing executable with UPX. Maybe the executable remains uncompressed. Resuming progress!")
          EndIf
       EndIf
    EndIf

    ; for convenience, we provide all QUERY_STRING-parameters as environment variables for the program:
    ; the URI "www.and51.de/index.pb?site=downloads&sort=asc" would create the environment variables
    ; "GET_site" with the value "downloads" and "GET_sort" with "asc". then you can easily catch them with the
    ; GetEnvironmentVariable() command. caution: you must decode them manually if neccessary with URLDecoder()
    If GetEnvironmentVariable("QUERY_STRING") And GetEnvironmentVariable("REQUEST_URI") ; check first param, but extract informations from second param
       Define query_exp=CreateRegularExpression(#PB_Any, "(?U)(?<=&).+(?==)")
       Dim querystrings.s(0)
       Define i, n=ExtractRegularExpression(query_exp, "&"+GetEnvironmentVariable("QUERY_STRING"), querystrings())
       For i=1 To n
          SetEnvironmentVariable("GET_"+querystrings(i-1), GetURLPart(GetEnvironmentVariable("REQUEST_URI"), querystrings(i-1)))
       Next
       SetEnvironmentVariable("PB_Interpreter_QueryStrings", Str(n))
    EndIf

    ; set some additional evironment variables to inform our later purebasic-executable about...
    SetEnvironmentVariable("PB_Interpreter_ProgramFilename", ProgramFilename())
    SetEnvironmentVariable("PB_Interpreter_Date", Str(Date()))
    SetEnvironmentVariable("PB_Interpreter_PBVersion", Str(#PB_Compiler_Version))
    If isParameter("-c") Or isParameter("--compress")
       SetEnvironmentVariable("PB_Interpreter_ParamCompress", "1")
    EndIf
    If isParameter("-w") Or isParameter("--warn")
       SetEnvironmentVariable("PB_Interpreter_ParamWarn", "1")
    EndIf
    If isParameter("-p") Or isParameter("--parse")
       SetEnvironmentVariable("PB_Interpreter_ParamParse", "1")
    EndIf
    SetEnvironmentVariable("PB_Interpreter_CreationTime", Str(ElapsedMilliseconds()-creation_time))

    ; now run our purebasic-executable. it will have all the environmentvariables that this process has.
    ; if we have POST-data, we will write it to the executable's input (stdin). therefore, the executable
    ; must open a console with OpenConsole() and read it with ReadConsoleData(). the executable
    ; can check, if there is POST-data: just call GetEnvironmentVariable("CONTENT_LENGTH"). this is
    ; the size of POST-data in bytes. if this env-var is non-existent or null, there is no data and the
    ; executable does not need to read anything; remember, a reading action with Input() or ReadConsoleData()
    ; blocks your program until an EOF has been written to the stdin. so avoid reading, if you can.
    ; we will also pass the ProgramParameter()'s, as described in line 19-30
    ; note 1: we will make use of WorkingDirectory$, so that the executable thinks, it would run in the same
    ; directory as the source code. so you get the feeling that your website only consists of .pb-files :-)
    ; Remember, the purebasic executable can read and set the directory with GetCurrentDirectory() and
    ; SetCurrentDirectory()
    ; note 2: the executable can also read its real directory with ProgramFilename()
    ; note 3: the executable is responsible for correct interaction between itself and the browser! therefore
    ; it needs to create a correct HTTP-header before generating any output. if you don't know what
    ; you must do, place these two lines at the top of your program:
    ;       PrintN("Content-Type: text/html")
    ;       PrintN("")
    ; note 4: all the executables output for the browser can be done with PrintN() and WriteConsoleData().
    ; note 5: remember all the env-vars, that we set for the executable. use them, if you need their informations
    ; note 6: the recommended way to create a "purebasic-made website" is this order:
    ;     1) OpenConsole()
    ;     2) read POST-Data, if neccessary
    ;     3) follow note 3
    ;     4) generate your output like in note 4
    ; note 7: try to avoid long breaks. my experience is, that when you have too long output-pauses,
    ; apache will simply dismiss your executable
    ; note 8: this interpreter now catches stderr, too. that means, you can write to stderr by using ConsoleError().
    ; text written to stderr should appear in the server's error_log!
    Define program=RunProgram(exe$, commandline$, GetPathPart(script_filename$), #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Error)
    If program
       ; pass over POST-data, if existent
       Define content_length=Val(GetEnvironmentVariable("CONTENT_LENGTH"))
       If content_length
          Define *buffer=AllocateMemory(content_length)
          If *buffer
             ReadConsoleData(*buffer, content_length)
             WriteProgramData(program, *buffer, content_length)
          Else
             ConsoleError("Warning: POST-data cannot be passed to executable's stdin due to insufficient memory allocation.")
          EndIf
          WriteProgramData(program, #PB_Program_Eof, 0) ; not neccessary when using CloseProgram(), but then reading doesnt work either
       EndIf
       
       Define available, size, *output=AllocateMemory(1000), stderr$
       If Not *output
          CloseProgram(program)
          KillProgram(program)
          error("Cannot handle executable's output due to insufficient memory allocation.")
       EndIf
       While ProgramRunning(program)
          ; handle exe's stderr (stderr might appaer in the webserver's error_log!)
          stderr$=ReadProgramError(program)
          If stderr$
             ConsoleError(stderr$)
          EndIf
          
          ; handle exe's stdout
          available=AvailableProgramOutput(program)
          If available
             If available > 1000 ; ensure reading in steps of 1000 bytes only, so we don't need a large buffer
                available=1000
             EndIf
             size=ReadProgramData(program, *output, available)
             ; redirecting programs output directly to apache by writing it to OUR console (our stdout)
             WriteConsoleData(*output, size)
             Continue ; speeds up the data redirection by skipping the Delay() below, if there is a continuous data flow
          EndIf
          Delay(5) ; do not consume the whole cpu time. find the optimal value yourself and let me know, please
          
          ; circumvent a bug in ProgramRunning() (this command always returns 1),
          ; see http://www.purebasic.fr/english/viewtopic.php?t=37273
          If ProgramExitCode(program) <> -1 : Break : EndIf
       Wend
    Else
       error("The compiled program cannot be started: "+exe$)
    EndIf

    ; the program execution has finished. now we delete the exe$ and the temp source file if enforced
    ; (see line 91-98)
    If isParameter("-f") Or isParameter("--force")
       DeleteFile(exe$)
    EndIf
    If source$
       DeleteFile(source$)
    EndIf

    ; keep in mind that this interpreter can do any stuff here, e. g. append advertisement, increase any counters, etc.

    ; we do not need to tidy up the rest (free buffers and other things), because PB does this
    ; automatically on program exit. the console will also be closed automatically
    End