From 7f3062c239ffdd81b4c1bb124a1f62c51a5938fe Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 13 Sep 2011 19:35:11 +0200 Subject: implemented a functioning file monitor class. It can track files and detect size and date changes to the monitored files. It uses a sha1 to detect any changes. The SHA1 is probably overkill for now, but it is planned to use it in future when Path Monitoring is implemented too. --- examples/apps/ide/src/filemonitor.pas | 195 ++++++++++++- examples/apps/ide/src/sha1.pas | 508 ++++++++++++++++++++++++++++++++++ 2 files changed, 699 insertions(+), 4 deletions(-) create mode 100644 examples/apps/ide/src/sha1.pas (limited to 'examples/apps/ide') diff --git a/examples/apps/ide/src/filemonitor.pas b/examples/apps/ide/src/filemonitor.pas index 0e0fa7a8..674109b2 100644 --- a/examples/apps/ide/src/filemonitor.pas +++ b/examples/apps/ide/src/filemonitor.pas @@ -5,28 +5,215 @@ unit filemonitor; interface uses - Classes, SysUtils, fpg_main; + Classes, SysUtils, fpg_main, fpg_base, contnrs; type + + TFileMonitorEventType = (fmeFileCreated, + fmeFileChanged, + fmeFileDeleted, + fmeFileRenamed, + fmeUnknownChange); + + TFileMonitorEventData = record + EventType: TFileMonitorEventType; + FileName: TfpgString; +// OldFileName: TfpgString; +// UserData: Pointer; + end; + + + TFileChangedEvent = procedure(Sender: TObject; AData: TFileMonitorEventData) of object; + + + + + TMonitoredFile = class(TObject) + private + FName: TfpgString; + FSize: Int64; + FDate: TDateTime; + FSHA1: TfpgString; + function AsString: TfpgString; + public + function GetNewSHA1: TfpgString; + procedure UpdateInfo; + property Name: TfpgString read FName write FName; + property Size: Int64 read FSize write FSize; + property Date: TDateTime read FDate write FDate; + property SHA1: TfpgString read FSHA1 write FSHA1; + end; + + TFileMonitor = class(TThread) private - FInterval: integer; + FInterval: LongWord; + FFileList: TObjectList; + FOnFileChanged: TFileChangedEvent; + FCurrent: TMonitoredFile; + FCurrentState: TFileMonitorEventType; + procedure DoFileChangeNotification; public + constructor CreateCustom; procedure Execute; override; - property Interval: integer read FInterval write FInterval; + property Interval: LongWord read FInterval write FInterval; + procedure AddFile(const AFilename: TfpgString); + procedure RemoveFile(const AFilename: TfpgString); + property OnFileChanged: TFileChangedEvent read FOnFileChanged write FOnFileChanged; end; + implementation +uses + fpg_utils, + sha1; + +function ReadFileDate(const AFileName: string): TDateTime; +var + fa: LongInt; +begin + fa := FileAge(AFileName); + Result := FileDateToDateTime(fa); +end; + +function ReadFileSize(const AFileName: string): DWord; +var + LFileStream: TFileStream; +begin + LFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); + try + Result := LFileStream.Size; + finally + LFileStream.Free; + end; +end; + +procedure ReadFileDateSize(const AFileName: string; var ADateTime: TDateTime; var AFileSize: Int64); +begin + ADateTime := ReadFileDate(AFileName); + AFileSize := ReadFileSize(AFileName); +end; + + +{ TMonitoredFile } + +function TMonitoredFile.AsString: TfpgString; +const + OBJ_AS_STRING = '%s %s %d'; +begin + Result := Format(OBJ_AS_STRING, [FName, FormatDateTime('yyyy-mm-dd hh:mm:ss', FDate), FSize]); +end; + +function TMonitoredFile.GetNewSHA1: TfpgString; +var + lFile: TMonitoredFile; + s: Int64; + d: TDateTime; +begin + s := 0; + d := 0.0; + lFile := TMonitoredFile.Create; + try + lFile.Name := FName; + ReadFileDateSize(lFile.Name, d, s); + lFile.Size := s; + lFile.Date := d; + + Result := SHA1ofStr(lFile.AsString); + finally + lFile.Free; + end; +end; + +procedure TMonitoredFile.UpdateInfo; +var + s: Int64; + d: TDateTime; +begin + ReadFileDateSize(Name, d, s); + Size := s; + Date := d; + SHA1 := SHA1ofStr(AsString); +end; + { TFileMonitor } +procedure TFileMonitor.DoFileChangeNotification; +var + rec: TFileMonitorEventData; +begin + if Assigned(FOnFileChanged) then + begin + rec.EventType := FCurrentState; + rec.FileName := FCurrent.Name; + FOnFileChanged(self, rec); + end; +end; + +constructor TFileMonitor.CreateCustom; +begin + Create(True); + FFileList := TObjectList.create; + FInterval := 500; +end; + procedure TFileMonitor.Execute; +var + i: integer; + lFile: TMonitoredFile; begin while not Terminated do begin - + if Assigned(FOnFileChanged) then + begin + for i := FFileList.Count-1 downto 0 do + begin + lFile := TMonitoredFile(FFileList[i]); + if fpgFileExists(lFile.Name) then + begin + if lFile.SHA1 <> lFile.GetNewSHA1 then + begin + FCurrent := lFile; + FCurrentState := fmeFileChanged; + Synchronize(@DoFileChangeNotification); + lFile.UpdateInfo; + end; + end + else + begin + FCurrent := lFile; + FCurrentState := fmeFileDeleted; + Synchronize(@DoFileChangeNotification); + FFileList.Remove(lFile); + end; + end; + end; + sleep(FInterval); end; end; +procedure TFileMonitor.AddFile(const AFilename: TfpgString); +var + lFile: TMonitoredFile; + s: Int64; + d: TDateTime; +begin + s := 0; + d := 0.0; + lFile := TMonitoredFile.Create; + lFile.Name := AFileName; + ReadFileDateSize(AFileName, d, s); + lFile.Size := s; + lFile.Date := d; + lFile.SHA1 := SHA1ofStr(lFile.AsString); + FFileList.Add(lFile); +end; + +procedure TFileMonitor.RemoveFile(const AFilename: TfpgString); +begin + // +end; + end. diff --git a/examples/apps/ide/src/sha1.pas b/examples/apps/ide/src/sha1.pas new file mode 100644 index 00000000..c67b9b41 --- /dev/null +++ b/examples/apps/ide/src/sha1.pas @@ -0,0 +1,508 @@ +// ============================================================================ +// D5-implementation of "US Secure Hash Algorithm 1 (SHA1)" (RFC3174) +// Copyright (c) 2001, Juergen Haible. +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to +// deal in the Software without restriction, including without limitation the +// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +// sell copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +// IN THE SOFTWARE. +// ============================================================================ + +{------------------------------------------------------------------------------ +Update by F. Piette for ICS (http://www.overbyte.be) +Jan 10, 2004 Defined uint32_t as Cardinal instead of LongInt +------------------------------------------------------------------------------} + + +unit Sha1; // "US Secure Hash Algorithm 1 (SHA1)" (RFC3174) + +{------------------------------------------------------------------------------ + + Based on the reference implementation in RFC 3174 + +------------------------------------------------------------------------------} + +interface + +{$R-} +{$Q-} + +uses SysUtils, Classes; + +const + shaSuccess = 0; + shaNull = 1; + shaInputTooLong = 2; + shaStateError = 3; + SHA1HashSize = 20; + +type + uint32_t = Cardinal; // unsigned 32 bit integer + uint8_t = Byte; // unsigned 8 bit integer (i.e., unsigned char) + int_least16_t = LongInt; // integer of >= 16 bits + + SHA1Digest = array[0..SHA1HashSize-1] of Char; + SHA1DigestString = AnsiString; // string containing 20 chars + + // This structure will hold context information for the SHA-1 + // hashing operation + SHA1Context = record + Intermediate_Hash: array[0..SHA1HashSize div 4-1] of uint32_t; // Message Digest + Length_Low : uint32_t; // Message length in bits + Length_High: uint32_t; // Message length in bits + Message_Block_Index: int_least16_t; // Index into message block array + Message_Block: array[0..63] of uint8_t; // 512-bit message blocks + Computed: Integer; // Is the digest computed? + Corrupted: Integer; // Is the message digest corrupted? + end; + +function SHA1Reset ( var context : SHA1Context ): Integer; +function SHA1Input ( var context : SHA1Context; + message_array : PChar; + length : Cardinal ): Integer; +function SHA1Result( var context : SHA1Context; + var Message_Digest: SHA1Digest ): Integer; + +function SHA1ofStr ( const s: String ): SHA1DigestString; +function SHA1ofBuf ( const buf; buflen: Integer ): SHA1DigestString; +function SHA1ofStream( const strm: TStream ): SHA1DigestString; + +function SHA1toHex( const digest: SHA1DigestString ): String; + +procedure HMAC_SHA1( const Data; DataLen: Integer; + const Key; KeyLen : Integer; + out Digest : SHA1Digest ); +function HMAC_SHA1_EX( const Data: String; + const Key : String ): String; //overload; + +implementation + +// Define the SHA1 circular left shift macro +function SHA1CircularShift( const bits, word: uint32_t ): uint32_t; +begin + Result := (((word) shl (bits)) or ((word) shr (32-(bits)))); +end; + +// This function will process the next 512 bits of the message +// stored in the Message_Block array. +procedure SHA1ProcessMessageBlock( var context: SHA1Context ); +const K: array[0..3] of uint32_t = ( //* Constants defined in SHA-1 */ + $5A827999, + $6ED9EBA1, + $8F1BBCDC, + $CA62C1D6 + ); +var + t: Integer; //* Loop counter */ + temp: uint32_t; //* Temporary word value */ + W: array[0..79] of uint32_t; //* Word sequence */ + A, B, C, D, E: uint32_t; //* Word buffers */ +begin + + // Initialize the first 16 words in the array W + for t := 0 to 15 do begin + W[t] := context.Message_Block[t * 4 ] shl 24 + or context.Message_Block[t * 4 + 1] shl 16 + or context.Message_Block[t * 4 + 2] shl 8 + or context.Message_Block[t * 4 + 3]; + end; + + for t := 16 to 79 do begin + W[t] := SHA1CircularShift(1,W[t-3] xor W[t-8] xor W[t-14] xor W[t-16]); + end; + + A := context.Intermediate_Hash[0]; + B := context.Intermediate_Hash[1]; + C := context.Intermediate_Hash[2]; + D := context.Intermediate_Hash[3]; + E := context.Intermediate_Hash[4]; + + for t := 0 to 19 do begin + temp := SHA1CircularShift(5,A) + + ((B and C) or ((not B) and D)) + E + W[t] + K[0]; + E := D; + D := C; + C := SHA1CircularShift(30,B); + B := A; + A := temp; + end; + + for t := 20 to 39 do begin + temp := SHA1CircularShift(5,A) + (B xor C xor D) + E + W[t] + K[1]; + E := D; + D := C; + C := SHA1CircularShift(30,B); + B := A; + A := temp; + end; + + for t := 40 to 59 do begin + temp := SHA1CircularShift(5,A) + + ((B and C) or (B and D) or (C and D)) + E + W[t] + K[2]; + E := D; + D := C; + C := SHA1CircularShift(30,B); + B := A; + A := temp; + end; + + for t := 60 to 79 do begin + temp := SHA1CircularShift(5,A) + (B xor C xor D) + E + W[t] + K[3]; + E := D; + D := C; + C := SHA1CircularShift(30,B); + B := A; + A := temp; + end; + + inc( context.Intermediate_Hash[0], A ); + inc( context.Intermediate_Hash[1], B ); + inc( context.Intermediate_Hash[2], C ); + inc( context.Intermediate_Hash[3], D ); + inc( context.Intermediate_Hash[4], E ); + + context.Message_Block_Index := 0; +end; + +// According to the standard, the message must be padded to an even +// 512 bits. The first padding bit must be a '1'. The last 64 +// bits represent the length of the original message. All bits in +// between should be 0. This function will pad the message +// according to those rules by filling the Message_Block array +// accordingly. It will also call the ProcessMessageBlock function +// provided appropriately. When it returns, it can be assumed that +// the message digest has been computed. +procedure SHA1PadMessage( var context: SHA1Context ); +begin + (* + * Check to see if the current message block is too small to hold + * the initial padding bits and length. If so, we will pad the + * block, process it, and then continue padding into a second + * block. + *) + if (context.Message_Block_Index > 55) then begin + context.Message_Block[context.Message_Block_Index] := $80; + inc( context.Message_Block_Index ); + while (context.Message_Block_Index < 64) do begin + context.Message_Block[context.Message_Block_Index] := 0; + inc( context.Message_Block_Index ); + end; + + SHA1ProcessMessageBlock( context ); + + while (context.Message_Block_Index < 56) do begin + context.Message_Block[context.Message_Block_Index] := 0; + inc( context.Message_Block_Index ); + end; + end else begin + context.Message_Block[context.Message_Block_Index] := $80; + inc( context.Message_Block_Index ); + while (context.Message_Block_Index < 56) do begin + context.Message_Block[context.Message_Block_Index] := 0; + inc( context.Message_Block_Index ); + end; + end; + + // Store the message length as the last 8 octets + context.Message_Block[56] := context.Length_High shr 24; + context.Message_Block[57] := context.Length_High shr 16; + context.Message_Block[58] := context.Length_High shr 8; + context.Message_Block[59] := context.Length_High; + context.Message_Block[60] := context.Length_Low shr 24; + context.Message_Block[61] := context.Length_Low shr 16; + context.Message_Block[62] := context.Length_Low shr 8; + context.Message_Block[63] := context.Length_Low; + + SHA1ProcessMessageBlock(context); +end; + +// This function will initialize the SHA1Context in preparation +// for computing a new SHA1 message digest. +function SHA1Reset( var context: SHA1Context ): Integer; +begin + // if (context=0) then begin Result:=shaNull; exit end; + + context.Length_Low := 0; + context.Length_High := 0; + context.Message_Block_Index := 0; + + context.Intermediate_Hash[0] := $67452301; + context.Intermediate_Hash[1] := $EFCDAB89; + context.Intermediate_Hash[2] := $98BADCFE; + context.Intermediate_Hash[3] := $10325476; + context.Intermediate_Hash[4] := $C3D2E1F0; + + context.Computed := 0; + context.Corrupted := 0; + + Result := shaSuccess; +end; + +// This function will return the 160-bit message digest into the +// Message_Digest array provided by the caller. +function SHA1Result( var context: SHA1Context; + var Message_Digest: SHA1Digest ): Integer; +var i: Integer; +begin + // if (!context || !Message_Digest) then begin Result:=shaNull; exit end; + + if (context.Corrupted<>0) then begin Result:=context.Corrupted; exit end; + + if (context.Computed=0) then begin + SHA1PadMessage( context ); + for i:=0 to 63 do begin + //* message may be sensitive, clear it out */ + context.Message_Block[i] := 0; + end; + context.Length_Low := 0; //* and clear length */ + context.Length_High := 0; + context.Computed := 1; + end; + + for i := 0 to SHA1HashSize-1 do begin + Message_Digest[i] := chr( context.Intermediate_Hash[i shr 2] + shr ( 8 * ( 3 - ( uint32_t(i) and $03 ) ) ) ); + end; + + Result := shaSuccess; +end; + +// This function accepts an array of octets as the next portion +// of the message. +function SHA1Input( var context: SHA1Context; + message_array: PChar; + length: Cardinal ): Integer; +begin + if (length=0) then begin Result:=shaSuccess; exit end; + // if (!context || !message_array) then begin Result:=shaNull; exit end; + if (message_array=nil) then begin Result:=shaNull; exit end; + + if (context.Computed<>0) then begin + context.Corrupted := shaStateError; + Result := shaStateError; + exit; + end; + + if (context.Corrupted<>0) then begin + Result := context.Corrupted; + exit; + end; + + while (length>0) and (context.Corrupted=0) do begin + context.Message_Block[context.Message_Block_Index] := (ord(message_array^) and $FF); + inc( context.Message_Block_Index ); + + inc( context.Length_Low, 8 ); + if (context.Length_Low = 0) then begin + inc( context.Length_High ); + if (context.Length_High = 0) then begin + // Message is too long + context.Corrupted := 1; + end; + end; + + if (context.Message_Block_Index = 64) then begin + SHA1ProcessMessageBlock(context); + end; + + inc( message_array ); + dec( length ); + end; + + Result := shaSuccess; +end; + +// ---------------------------------------------------------------------------- + +// returns SHA1 digest of given string +function SHA1ofStr( const s: String ): SHA1DigestString; +var context: SHA1Context; + digest : SHA1Digest; +begin + SHA1Reset ( context); + SHA1Input ( context, PChar( @s[1] ), length(s) ); + SHA1Result( context, digest ); + SetLength( Result, sizeof(digest) ); + Move( digest, Result[1], sizeof(digest) ); +end; + + +// returns SHA1 digest of given buffer +function SHA1ofBuf( const buf; buflen: Integer ): SHA1DigestString; +var context: SHA1Context; + digest : SHA1Digest; +begin + SHA1Reset ( context); + SHA1Input ( context, PChar( buf ), buflen ); + SHA1Result( context, digest ); + SetLength( Result, sizeof(digest) ); + Move( digest, Result[1], sizeof(digest) ); +end; + + +// returns SHA1 digest of given stream +function SHA1ofStream( const strm: TStream ): SHA1DigestString; +var context: SHA1Context; + digest : SHA1Digest; + buf: array[0..4095] of char; + buflen: Integer; +begin + SHA1Reset ( context); + strm.Position := 0; + repeat + buflen := strm.Read( buf[0], 4096 ); + if buflen>0 then SHA1Input ( context, buf, buflen ); + until buflen<4096; + SHA1Result( context, digest ); + SetLength( Result, sizeof(digest) ); + Move( digest, Result[1], sizeof(digest) ); +end; + + +// converts SHA1 digest into a hex-string + +function SHA1toHex( const digest: SHA1DigestString ): String; +var i: Integer; +begin + Result := ''; + for i:=1 to length(digest) do Result := Result + inttohex( ord( digest[i] ), 2 ); + Result := LowerCase( Result ); +end; + +// ---------------------------------------------------------------------------- + +// Keyed SHA1 (HMAC-SHA1), RFC 2104 + + +procedure HMAC_SHA1( const Data; DataLen: Integer; + const Key; KeyLen : Integer; + out Digest : SHA1Digest ); +var k_ipad, k_opad: array[0..64] of Byte; + Context: SHA1Context; + i : Integer; +begin + // clear pads + FillChar( k_ipad, sizeof(k_ipad), 0 ); + FillChar( k_opad, sizeof(k_ipad), 0 ); + + if KeyLen > 64 then begin + // if key is longer than 64 bytes reset it to key=SHA1(key) + SHA1Reset ( Context); + SHA1Input ( Context, PChar(@Key), KeyLen ); + SHA1Result( Context, Digest ); + // store key in pads + Move( Digest, k_ipad, SHA1HashSize ); + Move( Digest, k_opad, SHA1HashSize ); + end else begin + // store key in pads + Move( Key, k_ipad, KeyLen ); + Move( Key, k_opad, KeyLen ); + end; + + // XOR key with ipad and opad values + for i:=0 to 63 do begin + k_ipad[i] := k_ipad[i] xor $36; + k_opad[i] := k_opad[i] xor $5c; + end; + + // perform inner SHA1 + SHA1Reset ( Context ); + SHA1Input ( Context, PChar(@k_ipad[0]), 64 ); + SHA1Input ( Context, PChar(@Data), DataLen ); + SHA1Result( Context, Digest ); + + // perform outer SHA1 + SHA1Reset ( Context ); + SHA1Input ( Context, PChar(@k_opad[0]), 64 ); + SHA1Input ( Context, Digest, SHA1HashSize ); + SHA1Result( Context, Digest ); +end; + +function HMAC_SHA1_EX( const Data: String; + const Key : String ): String; +var Digest: SHA1Digest; +begin + HMAC_SHA1( Data[1], length(Data), Key[1], length(Key), Digest ); + SetLength( Result, SHA1HashSize ); + Move( digest[0], Result[1], SHA1HashSize ); +end; + +// ---------------------------------------------------------------------------- + +{ +SHA1 test suit: +procedure TForm1.Button1Click(Sender: TObject); +const TEST1 = 'abc'; + TEST2a = 'abcdbcdecdefdefgefghfghighijhi'; + TEST2b = 'jkijkljklmklmnlmnomnopnopq'; + TEST2 = TEST2a + TEST2b; + TEST3 = 'a'; + TEST4a = '01234567012345670123456701234567'; + TEST4b = '01234567012345670123456701234567'; + TEST4 = TEST4a + TEST4b; + testarray: array[0..3] of String = ( TEST1, TEST2, TEST3, TEST4 ); + repeatcount: array[0..3] of Integer = ( 1, 1, 1000000, 10 ); + resultarray: array [0..3] of String = ( + 'A9 99 3E 36 47 06 81 6A BA 3E 25 71 78 50 C2 6C 9C D0 D8 9D', + '84 98 3E 44 1C 3B D2 6E BA AE 4A A1 F9 51 29 E5 E5 46 70 F1', + '34 AA 97 3C D4 C4 DA A4 F6 1E EB 2B DB AD 27 31 65 34 01 6F', + 'DE A3 56 A2 CD DD 90 C7 A7 EC ED C5 EB B5 63 93 4F 46 04 52' ); +var sha: SHA1Context; + i, j, err: Integer; + Message_Digest: SHA1Digest; + s: String; +begin + for j := 0 to 3 do begin + ListBox1.Items.Add( Format( 'Test %d: %d, "%s"', + [ j+1, repeatcount[j], testarray[j] ] ) ); + + err := SHA1Reset(sha); + if (err<>0) then begin + ListBox1.Items.Add( Format( 'SHA1Reset Error %d.', [err] ) ); + break; //* out of for j loop */ + end; + + for i := 0 to repeatcount[j]-1 do begin + err := SHA1Input( sha, @testarray[j][1], length(testarray[j]) ); + if (err<>0) then begin + ListBox1.Items.Add( Format('SHA1Input Error %d.', [err] ) ); + break; //* out of for i loop */ + end; + end; + + err := SHA1Result(sha, Message_Digest); + if (err<>0) then begin + ListBox1.Items.Add( Format( + 'SHA1Result Error %d, could not compute message digest.', [err] ) ); + end else begin + s := ''; + for i := 0 to 19 do begin + s := s + Format('%02X ', [ ord(Message_Digest[i]) ] ); + end; + ListBox1.Items.Add( 'Result: ' + s ); + end; + + ListBox1.Items.Add( 'Wanted: ' + Format('%s', [resultarray[j]] ) ); + end; +end; + +HMAC-SHA1 test suite of RFC 2202: +procedure TForm1.Button3Click(Sender: TObject); +end; +} + +end. + -- cgit v1.2.3-70-g09d2