COPY, part 4

In this article we will we look at the support code referenced in the previous two articles.

function Invalid_Wildcard( const S : string ) : boolean ;

begin
    Result := False ;
    if( S = '*' ) then // Only a wildcard
    begin
        exit ;
    end ;
    if( pos( '*', S ) = 0 ) then // No wildcard embedded
    begin
        exit ;
    end ;
    Result := True ; // Must be a wildcard embedded with other characters
end ;

This function checks for invalid wildcard specifications as we discussed in the previous article. The only valid wildcard situation is a single "*" or no wildcards at all. You may note that there is no check for the "?" wildcard, but there is no need since we checked that earlier in the code (see previous articles).

// Compare filename F1 with wildcard specification F2
function Filename_Match( F1, F2 : string ) : boolean ;

var Node1, Access1, Node21, Device1, Path1, Name1, FType1, Version1 : string ;
    Node2, Access2, Node22, Device2, Path2, Name2, FType2, Version2 : string ;

begin
    Result := True ; // Assume match
    Parse_Filename( F1, Node1, Access1, Node21, Device1, Path1, Name1, FType1, Version1 ) ;
    Parse_Filename( F2, Node2, Access2, Node22, Device2, Path2, Name2, FType2, Version2 ) ;
    if( ( Node1 <> Node2 ) and ( not WC_Match( Node2, Node1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( Access1 <> Access2 ) and ( not WC_Match( Access2, Access1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( Node21 <> Node22 ) and ( not WC_Match( Node22, Node21 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( Device1 <> Device2 ) and ( not WC_Match( Device2, Device1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( Path1 <> Path2 ) and ( not WC_Match( Path2, Path1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( Name1 <> Name2 ) and ( not WC_Match( Name2, Name1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( FType1 <> FType2 ) and ( not WC_Match( FType2, FType1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
    if( ( Version1 <> Version2 ) and ( not WC_Match( Version2, Version1 ) ) ) then
    begin
        Result := False ;
        exit ;
    end ;
end ;

This function compares a filename with a wildcard specification to see if they match. All we do is parse both strings into the component parts and then compare each one to see if they match literally or as wildcards.

function Open( Name : string ; Flags : integer ) : TCOM_UOS_File ;

var SRB : TSRB ;

begin
    Set_String( Name, SRB ) ;
    Result := Open_File( int64( @SRB ), int64( @Flags ) ) ;
end ;

This function is a wrapper to Starlet's Open_File routine.

    function Parse_Protection( S : string ) : int64 ;

    var P : integer ;
        I : integer ;
        T, Temp : string ;

    begin
        // Setup...
        Result := 0 ;
        S := trim( lowercase( S ) ) ;

        // Remove optional parentheses...
        if( copy( S, 1, 1 ) = '(' ) then
        begin
            S := copy( S, 2, length( S ) ) ;
            if( copy( S, length( S ), 1 ) = ')' ) then
            begin
                setlength( S, length( S ) - 1 ) ;
            end ;
            S := trim( S ) ;
        end ;
        if( S = '' ) then
        begin
            Result := -2 ;
            exit ;
        end ;

        // Parse each item...
        while( S <> '' ) do
        begin
            I := pos( ',', S + ',' ) ;
            Temp := trim( copy( S, 1, I - 1 ) ) ;
            S := trim( copy( S, I + 1, length( S ) ) ) ;
            T := copy( Temp, 3, length( Temp ) ) ;
            if( copy( T, 2, 1 ) <> ':' ) then
            begin
                Result := -2 ;
                exit ;
            end ;
            P := 0 ;
            for I := 1 to length( T ) do // For each type of protection
            begin
                case T[ I ] of
                    'r' : P := P or PROTECTION_OWNER_READ ;
                    'w' : P := P or PROTECTION_OWNER_WRITE ;
                    'e' : P := P or PROTECTION_OWNER_EXECUTE ;
                    'd' : P := P or PROTECTION_OWNER_DELETE ;
                    else
                        begin
                            Result := -1 ;
                            exit ;
                        end ;
                end ;
            end ; // for I := 1 to length( T ) )
            case T[ 1 ] of
                'o' : begin
                          Result := Result or P ;
                          Protection_Mask := Protection_Mask and ( not PROTECTION_OWNER_MASK ) ;
                      end ;
                'g' : begin
                          Result := Result or ( P shl 4 ) ;
                          Protection_Mask := Protection_Mask and ( not PROTECTION_GROUP_MASK ) ;
                      end ;
                's' : begin
                          Result := Result or ( P shl 8 ) ;
                          Protection_Mask := Protection_Mask and ( not PROTECTION_SYSTEM_MASK ) ;
                      end ;
                'w' : begin
                          Result := Result or ( P shl 12 ) ;
                          Protection_Mask := Protection_Mask and ( not PROTECTION_WORLD_MASK ) ;
                      end ;
                else
                    begin
                        Result := -3 ;
                        exit ;
                    end ;
            end ;
        end ; // while( S <> '' )
    end ; // Parse_Protection

This local function parses a file protection specification. It strips off any parentheses, then processes each comma-delimited field. It not only returns the appropriately-set bits of a protection mask, but also sets the Protection_Mask variable so that we can mask off the portion of the file protection that was specified so it can be combined with the existing protections for the portions not specified.

    function Read_File( Count : int64 ) : boolean ;

    var I : integer ;
        Res : int64 ;

    begin
        if( Count > sizeof( Buffer ) ) then
        begin
            Count := sizeof( Buffer ) ;
        end ;
        F.Blockread( Buffer, Count, Res ) ;
        if( Res < Count ) then
        begin
            Count := Res ;
        end ;
        Result := ( F.IO_Error = nil ) or ( F.IO_Error.Get_Error = 0 ) ;
    end ;

This local function reads data from the input file, up to the amount of bytes specified. It returns true if successful.

    function Write_File( Count : int64 ) : boolean ;

    var I : integer ;
        Res : int64 ;

    begin
        if( Count > sizeof( Buffer ) ) then
        begin
            Count := sizeof( Buffer ) ;
        end ;
        Outfile.Blockwrite( Buffer, Count, Res ) ;
        if( Res < Count ) then
        begin
            Count := Res ;
        end ;
        Result := ( F.IO_Error = nil ) or ( F.IO_Error.Get_Error = 0 ) ;
    end ;

This local function writes from the buffer to the output file. It returns true if successful.

    procedure Copy_Stream( In_Stream, Out_Stream : integer ) ;

    var Count, Size : int64 ;

    begin
        Size := F.Stream_Length( In_Stream ) ;
        while( Size > 0 ) do
        begin
            if( Size > sizeof( Buffer ) ) then
            begin
                Count := sizeof( Buffer ) ;
            end else
            begin
                Count := Size ;
            end ;
            Size := Size - Count ;
            F.Read_Stream( In_Stream, P, Count, int64( @Buffer ) ) ;
            OutFile.Write_Stream( Out_Stream, P, Count, int64( @Buffer ) )  ;
        end ;
    end ;

This function copies a stream from the input file to the output file.

    function Open_Output( O : string ) : boolean ;

    var A : int64 ;
        Buffer : array[ 0..1023 ] of byte ;
        D : TCOM_UOS_File ;
        DS : string ;
        Exists : boolean ; // True if file already exists
        FilePrivs : int64 ;
        Res : int64 ;
        This_Protection : int64 ;
        Node, Access, Secondary_Node, Device, Path, Name, Extension, Version : string ;
        UIC : int64 ;

    begin
        Result := True ;
        Exists := File_Exists( O ) ;
        This_Protection := Protection and ( not Protection_Mask ) ;
        UIC := 0 ;
        FilePrivs := 0 ;
        if( Exists ) then
        begin
            OutFile := Open( O, FAB_V_UFO ) ;
            FilePrivs := OutFile.Privileges ;
            if( ( Priv and SETPRV ) = 0 ) then // No SETPRV privelege
            begin
                FilePrivs := FilePrivs and Priv ; // Limit file privileges to user's current privileges
            end ;
            OutFile.Free ;
            if( ( Priv and ( BYPASS or SYSPRV ) ) <> 0 ) then
            begin
                OutFile := Open( O, FAB_V_UFO ) ;
                UIC := OutFile.Owner ;
                OutFile.Free ;
                Parse_Filename( O, Node, Access, Secondary_Node, Device, Path,
                    Name, Extension, Version ) ;
                if( Versions ) then
                begin
                    if( O_Version = '' ) then
                    begin
                        O := O + ';1' ;
                    end else
                    begin
                        repeat
                            O_Version := ';' + 
                                inttostr( strtoint( copy( O_Version, 2, length( O_Version ) ) ) + 1 ) ;
                        until not File_Exists( O ) ; // Find non-existent version
                        O := Node + Access + Device + Path + Name + Extension + O_Version ;
                    end ;
                end else
                begin
                    DS := Node + Access + Device + Path ;
                    D := Open( DS, 0 ) ;
                    UIC := D.Owner ;
                    D.Free ;
                end ;
            end ; // if( ( Priv and ( BYPASS or SYSPRV ) ) <> 0 )
        end ; // if( Exists )

This local function is used to open the output file. After some setup, we see if the file already exists. If so, we get the file's privileges and then limit them to the user's privileges, unless they have SETPRV. If the user has BYPASS or SYSPRV, we get the file's owner UIC (otherwise UIC remains 0 indicating the current user). If /VERSION was used, we increment the output file's version number from the existing file (no version means we use version 1). We keep incrementing in case there are existing files until we have a unique name. Otherwise, we open the parent directory and get its owner UIC. See the documentation in the previous articles for a description of this behavior.

        if( Overlay ) then
        begin
            OutFile := Open( O, FAB_V_CIF or FAB_V_UFO or OFlags ) ;
        end else
        begin
            OutFile := Open( O, FAB_V_CIF or FAB_V_SUP or FAB_V_UFO or OFlags ) ;
        end ;
        if( OutFile = nil ) then
        begin
            Result := False ;
            exit ;
        end ;

Next we open the output file, using the appropriate flags. If the open failures, we exit with a False result.

        OutFile.Owner := UIC ;
        if( Use_Protection ) then
        begin
            if( Exists ) then
            begin
                OutFile.Protection := This_Protection or ( Outfile.Protection and Protection_Mask ) ;
            end else
            begin
                OutFile.Protection := This_Protection or ( DefProt and Protection_Mask ) ;
            end ;
        end ;

Now we set the output file's owner to UIC. If a file protection was specified, we combine it with the existing file's protection or the user's default protection, and assign it to the file.

        if( ( Allocation_Size > 0 ) and ( Allocation_Size > OutFile.Get_Size ) ) then
        begin
            Outfile.Seek( OutFile.Get_Size ) ;
            A := Allocation_Size - OutFile.Get_Size ;
            fillchar( Buffer, sizeof( Buffer ), 0 ) ;
            while( A > 0 ) do
            begin
                if( A > sizeof( Buffer ) ) then
                begin
                    Outfile.Blockwrite( Buffer, sizeof( Buffer ), Res ) ;
                end else
                begin
                    Outfile.Blockwrite( Buffer, A, Res ) ;
                end ;
                A := A - sizeof( Buffer ) ;
            end ;
            Outfile.Seek( 0 ) ;
        end ;
        if( F.Symlink and Symlink and ( Operation = Op_Copy ) ) then
        begin
            Outfile.Symlink := True ;
        end ;
    end ; // Open_Output

If an allocation size was specified, we pre-extend the file as appropriate, and then reset the file pointer to the start of the file. Finally, if the input file is a symbolic link, /SYMLINK was specified, and we are doing a copy operation, we set the output file to be a symbolic link. We don't do this on concatenation since it doesn't make logical sense. Note that checking both Symlink and F.Symlink is redundant, since F.Symlink will only be set if /SYMLINK is specified. But we include it here as documentation.

In the next article, we will look at the new system services we've referenced in the last several articles.