PureBoard

Code: Alles auswählen

Order Allow,Deny
Deny from all

Code: Alles auswählen

; Copyright: AND51, 2009
; 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).

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

; for later usage
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
Define commandline$,i, n=CountProgramParameters()
NewList parameters.s()
For i=1 To n
	commandline$+ProgramParameter(i-1)+" "
Next
n=CountString(commandline$, " ")
For i=1 To n
	AddElement(parameters())
		parameters()=StringField(commandline$, i, " ")
Next

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 is a param like /number=51,
	; you will 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")
		PrintN("Content-Type: text/html")
		PrintN("")
		PrintN(ErrorDescription$)
	EndIf
	End
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")
	exe$+FormatDate("_%yyyy-%mm-%dd_%hh-%ii-%ss_CanBeDeleted_", Date())+Str(Random(9999999))+".tmp"
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"
	
	; important: we need to filter the shebang-line, otherwise this would cause a syntax error.
	; fastest method: copy it and comment the first line.
	; if you know a faster method, please tell me (AND51 @ PB-forums)
	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
	
	; 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")
		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. Continuing!")
		EndIf
	EndIf
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))
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
			; write this to our stderr without exiting (as this is only a warning)
			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 then
	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")
	DeleteFile(exe$)
EndIf
If source$
	DeleteFile(source$)
EndIf

; keep in mind that this interpreter can do any stuff here, e. g. appending 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

Code: Alles auswählen

#!/purebasic/interpreter

OpenConsole() 
PrintN("Content-Type: text/html") 
PrintN("") 
Print("Hello from PureBasic")