PureBasic Forums - English

Code: Select all

#!"c:\pb43\interpreter.exe" -w

OpenConsole()
PrintN("Content-Type: text/html"+#LF$)

If OpenFile(0, "hitcounter.txt")
   hits=ReadLong(0)+1
   FileSeek(0, 0)
   WriteLong(0, hits)
Else
   Print("hitcounter.txt cannot be opened")
EndIf

Print("This page was accessed "+Str(hits)+" times.")

; IDE Options = PureBasic 4.51 (Windows - x86)
; EnableXP

Code: Select all

#!"c:\pb43\interpreter.exe" -w

OpenConsole()
PrintN("Content-Type: text/html")
PrintN("")

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(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", #DQUOTE$+source$+#DQUOTE$+" /EXE "+#DQUOTE$+exe$+#DQUOTE$+" /quiet", "", #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
		
	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