// ***************************************************************************** // Title.............. : Hang ISAPI Filter // // Modulname ......... : hang_filter.lpr (ISAPI-DLL) // Type .............. : Lazarus Project File // Author ............ : Udo Schmal // Development Status : 23.02.2014 // Operating System .. : Win32 // IDE ............... : Lazarus // ***************************************************************************** library hangFilter; {$mode objfpc}{$H+} {$R hang_Filter.res} uses Windows, SysUtils, Classes, DateUtils, isapi, GMTUtils, StatusUtils; type PItem = ^TItem; TItem = record Previous, Next: PItem; Host, Url, RequestHeader: string; Time: TDateTime; Length: integer; end; var LoggingLock, ReqLock: TRTLCriticalSection; root, LogFile, dllPath: string; RecycleAppPoolTimeout: integer; bRecycleAppPool: boolean; LastRequest: integer; Head, Tail: PItem; procedure Log(sLine: string; bTime: boolean = true); var f: textfile; fn: string; begin EnterCriticalSection(LoggingLock); try fn := LogFile + FormatDateTime('dd"."mm"."yyyy', Now) + '.log'; {$I-} AssignFile(f, fn); if FileExists(fn) then Append(f) else ReWrite(f); if bTime then Write(f, FormatDateTime('hh:nn:ss:zzz"|"', Now)); Writeln(f, StringReplace(sLine, #13#10, #13#10' | ', [rfReplaceAll])); CloseFile(f); IOResult; {$I+} finally LeaveCriticalSection(LoggingLock); end; end; function CreateFilterContext(const Host, Url, RequestHeader: string): PItem; begin EnterCriticalSection(ReqLock); try New(Result); result^.Host := Host; result^.Url := Url; result^.RequestHeader := RequestHeader; result^.Time := Now(); result^.Length := 0; result^.Previous := Tail^.Previous; result^.Next := Tail; Tail^.Previous^.Next := result; Tail^.Previous := result; finally LeaveCriticalSection(ReqLock); end; end; procedure DestroyFilterContext(const Item: PItem); begin EnterCriticalSection(ReqLock); try Item^.Previous^.Next := Item^.Next; Item^.Next^.Previous := Item^.Previous; Item^.Previous := nil; Item^.Next := nil; Dispose(Item); finally LeaveCriticalSection(ReqLock); end; end; function RunAs(const Filename, Param, Username, Password: string): DWORD; var hLogon: THandle; s: WideString; si: TStartupInfo; pi: TProcessInformation; begin SetLastError(0); if not LogonUser(PChar(Username), nil, PChar(Password), LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hLogon) then begin result := GetLastError; Log('RunAs Admin ... LogonUser failed.'); end else begin ZeroMemory(@si, sizeof(si)); si.cb := sizeof(si); ZeroMemory(@pi, sizeof(pi)); s := WideString(Filename) + WideString(' "') + WideString(Param) + WideString('"'); if CreateProcessAsUserW(hLogon, nil, PWideChar(s), nil, nil, False, CREATE_DEFAULT_ERROR_MODE + HIGH_PRIORITY_CLASS, nil, nil, @si, @pi) then result := 0 else begin Log('RunAs Admin CreateProcess failed.'); result := GetLastError; end; CloseHandle(hLogon); ZeroMemory(@Password[1], length(Password)); end; end; procedure ForceTermination(); var Item: PItem; begin bRecycleAppPool := true; Item := Head^.Next; while Item <> Tail do begin Log(Item^.Host + Item^.Url + #13#10'* Requested at: ' + FormatDateTime('hh:nn:ss:zzz', Item^.Time) + #13#10'* RequestHeader:' + #13#10'* ' + StringReplace(Item^.RequestHeader, #13#10, #13#10'* ', [rfReplaceAll])); Item := Item^.Next; end; RunAs(dllPath + 'RecycleAppPool.exe', 'DefaultAppPool', 'Administrator', '12345678'); end; function ExtractUrl(const AUrl: string): string; begin result := AUrl; if (pos('?', result)>0) then SetLength(result, pos('?', result)-1); if (pos('#', result)>0) then SetLength(result, pos('#', result)-1); if (pos('://', result)>0) then begin result := Copy(result, pos('://', result)+3); result := Copy(result, pos('/', result)); end; end; function ExtractUrlPath(const AUrl: string): string; begin result := ExtractUrl(AUrl); if LastDelimiter('/', result)>1 then SetLength(result, LastDelimiter('/', result)) else result := '/'; end; function ExtractUrlFilename(const AUrl: string): string; begin result := ExtractUrl(AUrl); if LastDelimiter('/', result) 0 then Dec(Size); SetString(result, Buffer, Size); end else result := ''; except Log('Error in ServerVariables'); end; end; function OnPreprocHeaders: integer; var PreprocHeader: PHTTP_FILTER_PREPROC_HEADERS; function GetHeaderValue(Name: string): string; var Buffer: array[0..4096] of char; lenBuffer : DWORD; begin result := ''; try lenBuffer := SizeOf(Buffer); // FillChar(Buffer, lenBuffer, #0); if PreprocHeader^.GetHeader(pfc, PChar(Name), Buffer, lenBuffer) then result := Buffer; except Log('GetHeaderValue Error'); end; end; procedure SetHeaderValue(Name: string; Value: string); begin try PreprocHeader^.SetHeader(pfc, PChar(Name), PChar(Value)); except Log('SetHeaderValue Error'); end; end; procedure AddHeaderValue(Name: string; Value: string); begin try PreprocHeader^.AddHeader(pfc, PChar(Name), PChar(Value)); except Log('AddHeaderValue Error'); end; end; function SendResponseHeader(status: string; const location: string = ''): integer; var str: string; Len: Cardinal; begin str := 'HTTP/1.1 ' + status + #13#10; if location<>'' then str := str + 'Location: ' + location + #13#10 ; str := str + 'Server: ' + ServerVariables('SERVER_SOFTWARE') + #13#10 + 'X-Powered-By: Hang ISAPI Filter, Udo Schmal'#13#10 + 'Date: ' + NowGMTStr() + #13#10 + #13#10#0; Len := Length(str); if pfc.WriteClient(pfc, PChar(str), Len, 0) then result := SF_STATUS_REQ_FINISHED else result := SF_STATUS_REQ_ERROR; end; procedure Timeout(); var sec: integer; ext: string; Item: PItem; begin Item := Head^.Next; if Item <> Tail then begin sec := SecondsBetween(Now, Item^.Time); ext := lowercase(ExtractUrlFileExtension(Item^.Url)); if (sec>RecycleAppPoolTimeout) and (pos(',' + ext + ',', ',.htm,.html,.asp,.dll,')<>0) then begin Log(Item^.Host + Item^.Url + ' (' + ext + ' ' + IntToStr(sec) + 'Sec.) --> RecycleAppPool' + #13#10'Requested at: ' + FormatDateTime('hh:nn:ss:zzz', Item^.Time) + #13#10'Request Header:' + #13#10 + Item^.RequestHeader); DestroyFilterContext(Item); if not bRecycleAppPool then ForceTermination(); end; end; end; var sHost, sUrl, sMethod, sRequestHeader, sExt: string; begin result := SF_STATUS_REQ_NEXT_NOTIFICATION; PreprocHeader := PHTTP_FILTER_PREPROC_HEADERS(pvNotification); sHost := ServerVariables('HTTP_HOST'); sUrl := GetHeaderValue('url'); sMethod := ServerVariables('HTTP_METHOD'); sRequestHeader := sMethod + ' ' + sUrl + #13#10 + ServerVariables('ALL_RAW'); pfc.pFilterContext := CreateFilterContext(sHost, sUrl, sRequestHeader); Timeout(); sExt := Lowercase(ExtractUrlFileExtension(sUrl)); if (result = SF_STATUS_REQ_NEXT_NOTIFICATION) and (pos(sExt, '.jpg.png.gif.txt.xml.js.css.ico.pdf.htc.zip.doc.ppt.xsl.swf.flv')=0) then begin if GetTickCount64-LastRequest<100 then Sleep(100-(GetTickCount64-LastRequest)); LastRequest := GetTickCount64; end; end; function OnLog: integer; var FilterLog: PHTTP_FILTER_LOG; Item: PItem; begin Item := pfc.pFilterContext; FilterLog := PHTTP_FILTER_LOG(pvNotification); if (FilterLog^.dwHttpStatus=500) and not bRecycleAppPool then begin Log(Item^.Host + Item^.Url + ' (HTTPStatus: ' + IntToStr(FilterLog^.dwHttpStatus) + ') --> RecycleAppPool' + #13#10'HTTPStatus: ' + IntToStr(FilterLog^.dwHttpStatus) + ' ' + http_Status_Msg(FilterLog^.dwHttpStatus) + #13#10'Win32Status: '+ win32_Error_Msg(FilterLog^.dwWin32Status) + #13#10'Requested at: ' + FormatDateTime('hh:nn:ss:zzz', Item^.Time) + #13#10'Request Header:' + #13#10 + Item^.RequestHeader); ForceTermination(); end else if (FilterLog^.dwHttpStatus<200) or (FilterLog^.dwHttpStatus>399) then Log(Item^.Host + Item^.Url + #13#10'HTTPStatus: ' + IntToStr(FilterLog^.dwHttpStatus) + ' ' + http_Status_Msg(FilterLog^.dwHttpStatus) + #13#10'Win32Status: '+ win32_Error_Msg(FilterLog^.dwWin32Status) + #13#10'Requested at: ' + FormatDateTime('hh:nn:ss:zzz', Item^.Time) + #13#10'Request Header:' + #13#10 + Item^.RequestHeader); DestroyFilterContext(pfc.pFilterContext); result := SF_STATUS_REQ_NEXT_NOTIFICATION; end; //HttpFilterProc mainline code begin result := SF_STATUS_REQ_NEXT_NOTIFICATION; if NotificationType = SF_NOTIFY_PREPROC_HEADERS then result := OnPreprocHeaders else if NotificationType = SF_NOTIFY_LOG then result := OnLog else result := SF_STATUS_REQ_NEXT_NOTIFICATION; end; exports GetFilterVersion, HttpFilterProc, TerminateFilter; function ModuleFileName(): string; var Buffer: array[0..MAX_PATH] of Char; begin FillChar(Buffer, SizeOf(Buffer), #0); SetString(result, Buffer, GetModuleFileName(hInstance, Buffer, Length(Buffer))); if pos('\\?\', result) = 1 then result := copy(result, 5, MAX_PATH); end; function ParentDir(const sPath: string): string; begin result := copy(sPath, 1, LastDelimiter(':\/', copy(sPath,1,length(sPath)-1))); end; var dllName: string; p, n: PItem; initialization InitCriticalSection(LoggingLock); dllName := ModuleFileName(); dllPath := ExtractFilePath(dllName); LogFile := ParentDir(dllPath) + 'logging\' + ChangeFileExt(ExtractFileName(dllName), ''); root := ParentDir(dllPath) + 'www-root'; Log('initialization ISAPI Filter!'); if IsLibrary then Log('is library'); if IsMultiThread then Log('is multithreaded'); InitCriticalSection(ReqLock); bRecycleAppPool := false; RecycleAppPoolTimeout := 120; New(Head); New(Tail); Head^.Previous := nil; Head^.Next := Tail; Tail^.Previous := Head; Tail^.Next := nil; LastRequest := GetTickCount64; finalization Log('finalization ISAPI Filter!'); p := Head^.Next; while (p<>Tail) do begin n := p^.Next; Dispose(p); p := n; end; Dispose(Head); Dispose(Tail); DoneCriticalsection(LoggingLock); DoneCriticalSection(ReqLock); end.