Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyOldSIVC.p

Text File | 1996-09-26 | 13.1 KB | 541 lines | [TEXT/CWIE]

unit MyOldSIVC;

interface

    uses
        Types;

    const
        PC_UseSIVC = 'SIVC';
        PC_FirstCheckSIVC = 'SIVd';
        PC_LastCheckSIVCQuantum = 'SICl';
        PC_CheckSIVCPeriod = 'SIVc';
        PC_LastSIVC = 'SIVL';
        PC_SIVCUsers = 'SIVU';

    type
        SIVCNewVersionCallBack = procedure(data:Handle; latest_version:Str31; where: Str255);
        SIVCGetSOCKSServerCallBack = procedure(const forhost: Str255; var server:Str255);
        SIVCManualQueryCallBack = procedure(err:OSErr; newversion, usingsocks:Boolean; data:Handle; latest_version:Str31; where: Str255);

    var
        first_ever_sivc: Boolean; { if this is the first time - warn the user! }

    procedure StartupSIVC;
    procedure ConfigureSIVC(newversion : SIVCNewVersionCallBack; getsocks:SIVCGetSOCKSServerCallBack);

    procedure ManualQuery(mqresult: SIVCManualQueryCallBack);
    function CanManualQuery:Boolean;

implementation

    uses
        Resources, Errors,
        MyVersionResource, MyStartup, TCPOOConnections, MyNewPreferences, MyUtils,
        MySocks, MyTranslateISO, MyMemory, MyHandleFile,
        PrefCodes;

    const
        sivc_id = 932;
        sivc_default_port = 7124;
        idle_til_period = 10 * 60 *60; { only even consider checking every 10 minutes }

    type
        SIVCStrings = (SS_None, SS_Server, SS_SOCKSServer, SS_Where);
        SIVCStates = (ST_None, ST_Doing, ST_Finished);
        ManualStates = (MS_None, MS_Want, MS_Doing);

    var
        manual_state: ManualStates;
        sivc_state: SIVCStates;
        mqresult_callback: SIVCManualQueryCallBack;
        newversion_callback: SIVCNewVersionCallBack;
        getsocks_callback: SIVCGetSOCKSServerCallBack;
        vers:versionRecord;
        app_creator: string[4];
        idle_til: longint;
        sivc_host: Str255;
        sivc_port:integer;

    procedure CallManualResult(err:OSErr; newversion, usingsocks:Boolean; data:Handle; latest_version:Str31; where: Str255);
    begin
        if (manual_state = MS_Doing) & (mqresult_callback <> nil) then begin
            mqresult_callback( err, newversion, usingsocks, data, latest_version, where );
            mqresult_callback := nil;
            manual_state := MS_None;
        end;
    end;

    procedure CallManualResultError( err: OSErr; usingsocks: boolean );
    begin
        CallManualResult( err, false, usingsocks, nil, '', '' );
    end;

    function GetThisQuantum:longint;
        var
            date,first_checked_date,check_period: longint;
    begin
        GetDateTime(date);
        prefs.GetTagLong(PC_FirstCheckSIVC,first_checked_date);
        prefs.GetTagLong(PC_CheckSIVCPeriod,check_period);
        GetThisQuantum := (date - first_checked_date) div 60 div check_period;
    end;

    procedure GetSOCKSServer( const forhost: Str255; var server:Str255 );
    begin
        server := '';
        if getsocks_callback <> nil then begin
            getsocks_callback( forhost, server );
        end;
        if server = '' then begin
            GetIndString( server, sivc_id, ord(SS_SOCKSServer) );
        end;
    end;

    procedure ServerToHostPort(s:Str255; defport:integer; var host:Str255; var port:integer);
        var
            portstr:Str255;
            n:longint;
    begin
        if SplitAt(s, ':', host, portstr) | SplitAt(s, ' ', host, portstr) then begin
            StringToNum(portstr,n);
            port := n;
        end else begin
            host := s;
            port := defport;
        end;
    end;

    function IsField(field:Str255; var line:Str255):Boolean;
        var
            s:Str255;
    begin
        IsField := false;
        if IsPrefix(line, field) then begin
            s := Trim(TPcopy(line, length(field)+1, 255));
            if (s<>'') & (s[1] = ':') then begin
                line := Trim(TPcopy(s, 2, 255));
                IsField := true;
            end;
        end;
    end;

    type
        SIVCConnection = object(LineConnectionObject)
            use_socks: boolean;
            sivc_ip: longint;
            query_result: Handle;
            procedure Established;
            override;
            function Create: OSErr;
            override;
            procedure Destroy;
            override;
            procedure Failed (oe: OSErr);
            override;
            procedure CharsAvailable( count: longint );
            override;
            procedure Closing;
            override;
            procedure Send( data: Ptr; len: integer );
            procedure SendQuery;
            procedure SendSocks;
            procedure ProcessResult;
            procedure Receive( data: Ptr; len: integer );
        end;
        SIVCLookup = object(AddressSearchObject)
            procedure Destroy;
            override;
            procedure FoundAddress (ip: longint);
            override;
            procedure Failed (oe: OSErr);
            override;
        end;

    var
        conn_obj: SIVCConnection;
        lookup_obj:SIVCLookup;

    function SIVCConnection.Create: OSErr;
    begin
        query_result := NewHandle( 0 );
        Create := inherited Create;
    end;

    procedure SIVCConnection.Destroy;
    begin
        conn_obj := nil;
        idle_til := TickCount + idle_til_period;
        sivc_state := ST_None;
        MDisposeHandle( query_result );
        inherited Destroy;
    end;

    procedure SIVCLookup.Destroy;
    begin
        lookup_obj := nil;
        idle_til := TickCount + idle_til_period;
        inherited Destroy;
    end;

    procedure SIVCLookup.FoundAddress (ip: longint);
        var
            s: Str255;
            socks_port: integer;
    begin
        new(conn_obj);
        conn_obj.use_socks := true;
        conn_obj.sivc_ip := ip;
        GetSOCKSServer( sivc_host, s );
        ServerToHostPort(s, socks_default_port, s, socks_port);
        conn_obj.NewActiveConnection( 0, s, socks_port );
    end;

    procedure SIVCLookup.Failed (oe: OSErr);
    begin
        CallManualResultError( oe, true );
        sivc_state := ST_None;
        inherited Failed( oe );
    end;

    procedure SIVCConnection.Failed (oe: OSErr);
    begin
        CallManualResultError( oe, use_socks );
        inherited Failed( oe );
    end;

    procedure SIVCConnection.Send( data: Ptr; len: integer );
        var
            err: OSErr;
    begin
        err := TCPSendAsync( tcpc, data, len, true, nil);
        if ( err <> noErr ) then begin
            Failed( err );
        end;
    end;

    procedure SIVCConnection.Receive( data: Ptr; len: integer );
        var
            err: OSErr;
    begin
        err := TCPRawReceiveChars( tcpc, data, len );
        if ( err <> noErr ) then begin
            Failed( err );
        end;
    end;

    procedure SIVCConnection.SendQuery;
        var
            query:Str255;
            count:integer;
    begin
        if (manual_state = MS_Doing) then begin
            query := 'Query: ProductInfoManual';
        end else begin
            query := 'Query: ProductInfoAuto';
        end;
        query := concat(query, cr,
                                'Product: ', vers.name, cr,
                                'ProductID: macos:APPL/',app_creator,cr,
                                'Version: ',HexNN(longint(vers.numericVersion),8),cr,
                                cr);
        count := MacToNet(@query[1],length(query));

        Send( @query[1], count);
    end;

    procedure SIVCConnection.SendSocks;
        var
            query:SocksRecord;
            len: longint;
    begin
        query.version := socks_version;
        query.cmd := socks_connect;
        query.port := sivc_port;
        query.ip := sivc_ip;
        query.name := concat('AnarchieSIVC', chr(0));
        len := SizeOf(SocksRecordSmall) + length(query.name);
        BlockMoveData(@query.name[1], @query.name, length(query.name));
        Send( @query, len );
    end;

    procedure SIVCConnection.Established;
    begin
        timeout_time := TickCount + 60*60*2;
        if ( use_socks ) then begin
            SendSocks;
        end else begin
            SendQuery;
        end;
    end;

    procedure SIVCConnection.CharsAvailable( count: longint );
        var
            size: longint;
            socksresult:SocksRecordSmall;
            err: OSErr;
    begin
        if ( use_socks ) then begin
            if count >= SizeOf(socksresult) then begin
                Receive( @socksresult, SizeOf(socksresult) );
                if not timetodie & (socksresult.cmd <> socks_result) then begin
                    Failed( -2 );
                end;
                if not timetodie then begin
                    use_socks := false;
                    SendQuery;
                end;
            end;
        end else begin
            size := GetHandleSize( query_result );
            err := MSetHandleSize( query_result, size + count );
            if ( err <> noErr ) then begin
                Failed( err );
            end else begin
                HLock( query_result );
                Receive( Ptr(longint(query_result^) + size), count );
                HUnlock( query_result );
            end;
        end;
    end;

    procedure SIVCConnection.ProcessResult;
        var
            hf:HandleFile;
            line:Str255;
            where: Str255;
            latest_version:longint;
            query_interval, users:longint;
            ver:NumVersion;
            new:boolean;
            gotversion: boolean;
    begin
        hf.data := query_result;
        hf.pos := 0;
        hf.crlf := CL_CR;
        hf.error := noErr;
        latest_version := -1;
        GetIndString( where, sivc_id, ord(SS_Where) );
        gotversion := false;
        while ReadFromHandleFile(hf, line) do begin
            if IsField('ReleaseVersion', line) then begin
                latest_version := HexToNum(line);
                gotversion := true;
            end else if IsField('AutoQueryIntervalM', line) then begin
                StringToNum(line, query_interval);
                if (query_interval >= 1440) & (query_interval < 136800) then begin { 1 to 95 days }
                    prefs.SetTagLong(PC_CheckSIVCPeriod, query_interval);
                end;
            end else if IsField('UserCount',line) then begin
                StringToNum(line, users);
                prefs.SetTagLong(PC_SIVCUsers, users);
            end else if IsField( 'ReleaseURL', line ) then begin
                where := line;
            end;
        end;
        new := (latest_version > longint(vers.numericVersion));
        line := '';
        if (latest_version <> -1) then begin
            ver := NumVersion(latest_version);
            line:=concat(NumToStr(ver.majorRev),'.',
                                NumToStr(BAND(ver.minorAndBugRev div 16,$0F)),'.',
                                NumToStr(BAND(ver.minorAndBugRev,$0F))
                                );
            if (ver.stage<>$80) or (ver.nonRelRev<>0) then begin
                case ver.stage of
                    $20:begin
                        line:=concat(line,'d');
                    end;
                    $40:begin
                        line:=concat(line,'a');
                    end;
                    $60:begin
                        line:=concat(line,'b');
                    end;
                    $80:begin
                        line:=concat(line,'f');
                    end;
                    otherwise begin
                        line:=concat(line,'<',NumToStr(ver.stage),'>');
                    end;
                end;
                if ver.nonRelRev <> 0 then begin
                    line:=concat(line,NumToStr(ver.nonRelRev));
                end;
            end;
        end;
        if manual_state = MS_Doing then begin
            if not gotversion then begin
                CallManualResultError( -17, use_socks );
            end else begin
                CallManualResult( noErr, new, use_socks, query_result, line, where );
            end;
        end else begin
            if new & (newversion_callback <> nil) then begin
                newversion_callback(query_result, line, where);
            end;
        end;
    end;

    procedure SIVCConnection.Closing;
        var
            size: longint;
            date: longint;
            junk: OSErr;
    begin
        HLock( query_result );
        size := NetToMac( query_result^, GetHandleSize( query_result ) );
        HUnlock( query_result );
        SetHandleSize( query_result, size );
        Close;
        GetDateTime(date);
        prefs.SetTagLong(PC_LastSIVC,date);
        ProcessResult;
        if (manual_state <> MS_Doing) then begin
            prefs.SetTagLong(PC_LastCheckSIVCQuantum, GetThisQuantum);
        end;
        junk := WritePrefsData;
    end;

    procedure ReleaseConnection;
    begin
        if ( conn_obj <> nil ) then begin
            conn_obj.Destroy;
        end;
        if ( lookup_obj <> nil ) then begin
            lookup_obj.Destroy;
        end;
        sivc_state := ST_None;
    end;

    procedure StartQuery;
        var
            s: Str255;
            use_socks: boolean;
    begin
        sivc_state := ST_Doing;
        GetIndString(s,sivc_id,ord(SS_Server));

        s := 'tiny';

        ServerToHostPort(s,sivc_default_port,sivc_host,sivc_port);
        GetSOCKSServer( sivc_host, s );
        use_socks := s<>'';
        if ( use_socks ) then begin
            new(lookup_obj);
            lookup_obj.FindAddress( sivc_host );
        end else begin
            new(conn_obj);
            conn_obj.use_socks := false;
            conn_obj.NewActiveConnection( 0, sivc_host, sivc_port );
        end;
    end;

    procedure IdleSIVC;
        var
            last_quantum: longint;
    begin
        if sivc_state = ST_None then begin
            if (manual_state = MS_Want) | (TickCount > idle_til) then begin
                if (manual_state = MS_Want) then begin
                    manual_state := MS_Doing;
                    StartQuery;
                end else begin
                    idle_til := TickCount + idle_til_period;
                    if prefs.GetTagBoolean(PC_UseSIVC) then begin
                        prefs.GetTagLong(PC_LastCheckSIVCQuantum,last_quantum);
                        if (GetThisQuantum <> last_quantum) then begin
                            StartQuery;
                        end;
                    end;
                end;
            end
        end;
    end;

    function InitSIVC( var msg: integer ): OSStatus;
        var
            bndl:Handle;
            date:longint;
            junk: OSErr;
    begin
{$unused(msg)}
        conn_obj := nil;
        lookup_obj := nil;
        manual_state := MS_None;
        sivc_state := ST_None;
        idle_til := TickCount;
        GetVersion(vers);
        app_creator := '????';
        bndl := Get1Resource('BNDL', 128);
        if (bndl <> nil) & (bndl^ <> nil) & (GetHandleSize(bndl) >= 4) then begin
            BlockMoveData(bndl^, @app_creator[1], 4);
        end;
        GetDateTime(date);
        SetDefaultLong(PC_FirstCheckSIVC,date);
        SetDefaultLong(PC_LastCheckSIVCQuantum,-1234);
        SetDefaultLong(PC_CheckSIVCPeriod,10080); { 1 week }
        SetDefaultLong(PC_LastSIVC,bad_date);
        SetDefaultLong(PC_SIVCUsers,-1);
        first_ever_sivc := not prefs.ExistsTag(PC_UseSIVC);
        junk := WritePrefsData;
        InitSIVC := noErr;
    end;

    procedure FinishSIVC;
    begin
        ReleaseConnection;
        sivc_state := ST_Finished;
    end;

    procedure ConfigureSIVC(newversion : SIVCNewVersionCallBack; getsocks:SIVCGetSOCKSServerCallBack);
    begin
        newversion_callback := newversion;
        getsocks_callback := getsocks;
        StartupSIVC;
    end;

    procedure StartupSIVC;
    begin
        StartupConnections;
        SetStartup( InitSIVC, IdleSIVC, 60*10, FinishSIVC );
    end;

    procedure ManualQuery(mqresult: SIVCManualQueryCallBack);
    begin
        if CanManualQuery then begin
            mqresult_callback := mqresult;
            manual_state := MS_Want;
        end else begin
            if (mqresult <> nil) then begin
                mqresult( aspServerBusy, false, false, nil, '', '' );
            end;
        end;
    end;

    function CanManualQuery:Boolean;
    begin
        CanManualQuery := (manual_state = MS_None) & (sivc_state <> ST_Finished);
    end;

end.
    procedure StartupSIVC;
    begin
    end;

    procedure ConfigureSIVC(newversion : SIVCNewVersionCallBack; getsocks:SIVCGetSOCKSServerCallBack);
    begin
    end;

    procedure ManualQuery(mqresult: SIVCManualQueryCallBack);
    begin
    end;

    function CanManualQuery:Boolean;
    begin
        CanManualQuery := false;
    end;

end.