ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBExtract.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBExtract.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 19 | Line 19
19   {    IBX For Lazarus (Firebird Express)                                  }
20   {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
21   {    Portions created by MWA Software are copyright McCallum Whyman      }
22 < {    Associates Ltd 2011                                                 }
22 > {    Associates Ltd 2011 - 2018                                               }
23   {                                                                        }
24   {************************************************************************}
25  
# Line 31 | Line 31 | Database Triggers (2.1)
31   Global Temporary Tables (2.1)
32   Boolean Type (3.0)
33   Identity Column Type (3.0)
34 + DDL Triggers (3.0)
35   }
36  
37   unit IBExtract;
# Line 57 | Line 58 | type
58  
59    TExtractType =
60      (etDomain, etTable, etRole, etTrigger, etForeign,
61 <     etIndex, etData, etGrant, etCheck);
61 >     etIndex, etData, etGrant, etCheck, etGrantsToUser);
62  
63    TExtractTypes = Set of TExtractType;
64  
# Line 77 | Line 78 | type
78      function GetDatabase: TIBDatabase;
79      function GetIndexSegments ( indexname : String) : String;
80      function GetTransaction: TIBTransaction;
81 <    function GetTriggerType(TypeID: integer): string;
81 >    function GetTriggerType(TypeID: Int64): string;
82      procedure SetDatabase(const Value: TIBDatabase);
83      procedure SetTransaction(const Value: TIBTransaction);
84      function PrintValidation(ToValidate : String;       flag : Boolean) : String;
85 <    procedure ShowGrants(MetaObject: String; Terminator : String);
85 >    procedure ShowGrants(MetaObject: String; Terminator : String; NoUserGrants: boolean=false);
86      procedure ShowGrantsTo(MetaObject: String; ObjectType: integer;
87        Terminator: String);
88      procedure ShowGrantRoles(Terminator : String);
89      procedure GetProcedureArgs(Proc : String);
90    protected
91 <    function ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean =
92 <      false): Boolean;
91 >    function ExtractDDL(Flag: Boolean; TableName: String; ExtractTypes: TExtractTypes =
92 >      []): Boolean;
93      function ExtractListTable(RelationName, NewName: String; DomainFlag: Boolean): Boolean;
94      procedure ExtractListView (ViewName : String);
95      procedure ListData(ObjectName : String);
96 <    procedure ListRoles(ObjectName : String = '');
97 <    procedure ListGrants;
96 >    procedure ListRoles(ObjectName : String = ''; IncludeGrants:boolean=false);
97 >    procedure ListGrants(ExtractTypes : TExtractTypes = []);
98      procedure ListProcs(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
99        IncludeGrants:boolean=false);
100      procedure ListAllTables(flag : Boolean);
# Line 274 | Line 275 | const
275      '  FDIM.RDB$FIELD_NAME = :FIELDNAME ' +
276      'ORDER BY FDIM.RDB$DIMENSION';
277  
278 + type
279 +  TTriggerPhase = (tpNone,tpCreate,tpAlter,tpDrop);
280 +
281 +  TDDLTriggerMap = record
282 +    ObjectName: string;
283 +    Bits: integer;
284 +    Bit1: TTriggerPhase;
285 +    Bit2: TTriggerPhase;
286 +    Bit3: TTriggerPhase;
287 +  end;
288 +
289 + const
290 +  DDLTriggers : array [0..15] of TDDLTriggerMap = (
291 +  (ObjectName: 'TABLE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
292 +  (ObjectName: 'PROCEDURE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
293 +  (ObjectName: 'FUNCTION'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
294 +  (ObjectName: 'TRIGGER'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
295 +  (ObjectName: 'Empty slot'; Bits: 3; Bit1: tpNone; Bit2: tpNone; Bit3: tpNone),
296 +  (ObjectName: 'EXCEPTION'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
297 +  (ObjectName: 'VIEW'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
298 +  (ObjectName: 'DOMAIN'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
299 +  (ObjectName: 'ROLE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
300 +  (ObjectName: 'INDEX'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
301 +  (ObjectName: 'SEQUENCE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
302 +  (ObjectName: 'USER'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
303 +  (ObjectName: 'COLLATION'; Bits: 2; Bit1: tpCreate; Bit2: tpDrop; Bit3: tpNone),
304 +  (ObjectName: 'CHARACTER SET'; Bits: 1; Bit1: tpAlter; Bit2: tpNone; Bit3: tpNone),
305 +  (ObjectName: 'PACKAGE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
306 +  (ObjectName: 'PACKAGE BODY'; Bits: 2; Bit1: tpCreate; Bit2: tpDrop; Bit3: tpNone)
307 + );
308 +
309   { TIBExtract }
310  
311   {                       ArrayDimensions
# Line 331 | Line 363 | begin
363    inherited;
364   end;
365  
366 < function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean = false) : Boolean;
366 > function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String;
367 >  ExtractTypes: TExtractTypes): Boolean;
368   var
369          DidConnect : Boolean;
370          DidStart : Boolean;
# Line 368 | Line 401 | begin
401      ListFunctions;
402      ListDomains;
403      ListAllTables(flag);
404 <    if IncludeData then
404 >    if etData in ExtractTypes then
405        ListData('');
406      ListIndex;
407      ListForeign;
408 <    if IncludeData then
408 >    if etData in ExtractTypes then
409        ListGenerators('',[etData])
410      else
411        ListGenerators;
# Line 382 | Line 415 | begin
415      ListProcs(pdCreateStub);
416      ListTriggers;
417      ListProcs(pdAlterProc);
418 <    ListGrants;
418 >    ListGrants(ExtractTypes);
419    end;
420  
421    if DidStart then
# Line 436 | Line 469 | const
469   var
470    Collation, CharSetId : integer;
471          i : integer;
472 <  ColList, Column, Constraint : String;
472 >  Column, Constraint : String;
473    SubType : integer;
474    IntChar : integer;
475    qryTables, qryPrecision, qryConstraints, qryRelConstraints, qryGenerators : TIBSQL;
# Line 446 | Line 479 | var
479    TableType: integer;
480   begin
481    Result := true;
449 –  ColList := '';
482    IntChar := 0;
483    ValidRelation := false;
484  
# Line 617 | Line 649 | begin
649          end;
650  
651          {Firebird 3 introduces IDENTITY columns. We need to check for them here}
652 <        if qryTables.HasField('RDB$GENERATOR_NAME') then
652 >        if qryTables.HasField('RDB$GENERATOR_NAME') and not qryTables.FieldByName('RDB$GENERATOR_NAME').IsNull then
653          begin
654            qryGenerators.ParamByName('GENERATOR').AsString :=  qryTables.FieldByName('RDB$GENERATOR_NAME').AsString;
655            qryGenerators.ExecQuery;
# Line 755 | Line 787 | var
787    qryViews, qryColumns : TIBSQL;
788    RelationName, ColList : String;
789   begin
790 +  ColList := '';
791    qryViews := TIBSQL.Create(FDatabase);
792    qryColumns := TIBSQL.Create(FDatabase);
793    try
# Line 899 | Line 932 | begin
932    Result := FTransaction;
933   end;
934  
935 < function TIBExtract.GetTriggerType(TypeID: integer): string;
935 > function TIBExtract.GetTriggerType(TypeID: Int64): string;
936 > const
937 >  AllDDLTriggers = $7FFFFFFFFFFFDFFF shr 1;
938   var separator: string;
939 +    i: integer;
940 +
941 +  function GetDDLEvent(Phase: TTriggerPhase; ObjectName: string): string;
942 +  begin
943 +    Result := '';
944 +    case Phase of
945 +    tpCreate:
946 +     Result := separator + 'CREATE ' + ObjectName;
947 +    tpAlter:
948 +     Result := separator + 'ALTER ' + ObjectName;
949 +    tpDrop:
950 +     Result := separator + 'Drop ' + ObjectName;
951 +    end;
952 +    if Result <> '' then
953 +      separator := ' OR ';
954 +  end;
955 +
956   begin
957    if TypeID and $2000 <> 0 then
958    {database trigger}
# Line 920 | Line 972 | begin
972      end;
973    end
974    else
975 +  if TypeID and $4000 <> 0 then
976 +  {DDL Trigger}
977 +  begin
978 +    if TypeID and $01 <> 0 then
979 +      Result := 'AFTER '
980 +    else
981 +      Result := 'BEFORE ';
982 +    TypeID := TypeID shr 1;
983 +    separator := '';
984 +    i := 0;
985 +    if TypeID = AllDDLTriggers then
986 +      Result += 'ANY DDL STATEMENT'
987 +    else
988 +      repeat
989 +        if (DDLTriggers[i].Bits > 0) and (TypeID and $01 <> 0) then
990 +         Result += GetDDLEvent(DDLTriggers[i].Bit1,DDLTriggers[i].ObjectName);
991 +
992 +        if (DDLTriggers[i].Bits > 1) and (TypeID and $02 <> 0) then
993 +          Result += GetDDLEvent(DDLTriggers[i].Bit2,DDLTriggers[i].ObjectName);
994 +
995 +        if (DDLTriggers[i].Bits > 2) and (TypeID and $04 <> 0) then
996 +          Result += GetDDLEvent(DDLTriggers[i].Bit3,DDLTriggers[i].ObjectName);
997 +        TypeID := TypeID shr DDLTriggers[i].Bits;
998 +        Inc(i);
999 +      until TypeID = 0;
1000 +  end
1001 +  else
1002 +  {Normal Trigger}
1003    begin
1004      Inc(TypeID);
1005      if TypeID and $01 <> 0 then
# Line 940 | Line 1020 | begin
1020          Result += 'DELETE';
1021        end;
1022        TypeID := TypeID shr 2;
1023 <    until TypeID = 0;
1024 <  end;
1023 >    until TypeID = 0
1024 >  end
1025   end;
1026  
1027   {          ListAllGrants
# Line 949 | Line 1029 | end;
1029           Print the permissions on all user tables.
1030           Get separate permissions on table/views and then procedures }
1031  
1032 < procedure TIBExtract.ListGrants;
1032 > procedure TIBExtract.ListGrants(ExtractTypes: TExtractTypes);
1033   const
1034    SecuritySQL = 'SELECT * FROM RDB$RELATIONS ' +
1035                  'WHERE ' +
# Line 957 | Line 1037 | const
1037                  '  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
1038                  'ORDER BY RDB$RELATION_NAME';
1039  
1040 +  DomainSQL  = 'select RDB$FIELD_NAME from RDB$FIELDS '+
1041 +    'where RDB$SYSTEM_FLAG <> 1 and RDB$FIELD_NAME not Similar to ''RDB$%|SEC$%|MON$%|SQL$%'' '+
1042 +    'order BY RDB$FIELD_NAME';
1043 +
1044 +  CharacterSetSQL = 'Select * From RDB$CHARACTER_SETS  '+
1045 +                    'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1046 +                    'Order by RDB$CHARACTER_SET_NAME';
1047 +
1048 +  CollationsSQL = 'Select * From RDB$COLLATIONS  '+
1049 +                    'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1050 +                    'Order by RDB$COLLATION_NAME';
1051 +
1052    ProcedureSQL = 'select * from RDB$PROCEDURES '+
1053                   'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1054                   'Order BY RDB$PROCEDURE_NAME';
# Line 969 | Line 1061 | const
1061                   'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1062                   'Order BY RDB$GENERATOR_NAME';
1063  
1064 +  MetadataGrantsSQL =
1065 +  'Select PR.RDB$USER, PR.RDB$USER_TYPE, '+
1066 +  'T.RDB$TYPE_NAME as USER_TYPE_NAME, '+
1067 +  'Case PR.RDB$PRIVILEGE '+
1068 +  '  When ''C'' then ''CREATE'' '+
1069 +  '  When ''O'' then ''DROP ANY'' '+
1070 +  '  When ''L'' then ''ALTER ANY''  End as Privilege, '+
1071 +  'Case PR.RDB$RELATION_NAME '+
1072 +  '  When ''SQL$COLLATIONS'' then ''COLLATION'' '+
1073 +  '  When ''SQL$CHARSETS'' then ''CHARACTER SET'' '+
1074 +  '  When ''SQL$DATABASE'' then ''DATABASE'' '+
1075 +  '  When ''SQL$DOMAINS'' then ''DOMAIN'' '+
1076 +  '  When ''SQL$EXCEPTIONS'' then ''EXCEPTION'' '+
1077 +  '  When ''SQL$FILTERS'' then ''FILTER'' '+
1078 +  '  When ''SQL$FUNCTIONS'' then ''FUNCTION'' '+
1079 +  '  When ''SQL$GENERATORS'' then ''GENERATOR'' '+
1080 +  '  When ''SQL$PACKAGES'' then ''PACKAGE'' '+
1081 +  '  When ''SQL$PROCEDURES'' then ''PROCEDURE'' '+
1082 +  '  When ''SQL$ROLES'' then ''ROLE'' '+
1083 +  '  When ''SQL$VIEWS'' then ''VIEW'' '+
1084 +  '  When ''SQL$TABLES'' then ''TABLE'' End as METAOBJECTNAME,'+
1085 +
1086 +  'case when coalesce(RDB$GRANT_OPTION,0) <> 0 then '' WITH GRANT OPTION'' '+
1087 +  'ELSE '''' End as GRANTOPTION '+
1088 +  'FROM RDB$USER_PRIVILEGES PR '+
1089 +  'JOIN RDB$TYPES T On T.RDB$TYPE = PR.RDB$USER_TYPE and T.RDB$FIELD_NAME = ''RDB$OBJECT_TYPE'' '+
1090 +  'Where PR.RDB$RELATION_NAME like ''SQL$%'' and PR.RDB$PRIVILEGE in (''L'',''C'',''O'')';
1091 +
1092   var
1093    qryRoles : TIBSQL;
1094    RelationName : String;
# Line 989 | Line 1109 | begin
1109        while not qryRoles.Eof do
1110        begin
1111          RelationName := Trim(qryRoles.FieldByName('rdb$relation_Name').AsString);
1112 <        ShowGrants(RelationName, Term);
1112 >        ShowGrants(RelationName, Term, not (etGrantsToUser in ExtractTypes));
1113          qryRoles.Next;
1114        end;
1115      finally
# Line 998 | Line 1118 | begin
1118  
1119      ShowGrantRoles(Term);
1120  
1121 <    qryRoles.SQL.Text := ExceptionSQL;
1122 <    qryRoles.ExecQuery;
1123 <    try
1124 <      while not qryRoles.Eof do
1125 <      begin
1126 <        ShowGrants(Trim(qryRoles.FieldByName('RDB$EXCEPTION_NAME').AsString), Term);
1127 <        qryRoles.Next;
1121 >    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
1122 >    begin
1123 >      qryRoles.SQL.Text := DomainSQL;
1124 >      qryRoles.ExecQuery;
1125 >      try
1126 >        while not qryRoles.Eof do
1127 >        begin
1128 >          ShowGrants(Trim(qryRoles.FieldByName('RDB$FIELD_NAME').AsString), Term,
1129 >                  not (etGrantsToUser in ExtractTypes));
1130 >          qryRoles.Next;
1131 >        end;
1132 >      finally
1133 >        qryRoles.Close;
1134 >      end;
1135 >
1136 >      qryRoles.SQL.Text := CharacterSetSQL;
1137 >      qryRoles.ExecQuery;
1138 >      try
1139 >        while not qryRoles.Eof do
1140 >        begin
1141 >          ShowGrants(Trim(qryRoles.FieldByName('RDB$CHARACTER_SET_NAME').AsString), Term,
1142 >              not (etGrantsToUser in ExtractTypes));
1143 >          qryRoles.Next;
1144 >        end;
1145 >      finally
1146 >        qryRoles.Close;
1147 >      end;
1148 >
1149 >      qryRoles.SQL.Text := CollationsSQL;
1150 >      qryRoles.ExecQuery;
1151 >      try
1152 >        while not qryRoles.Eof do
1153 >        begin
1154 >          ShowGrants(Trim(qryRoles.FieldByName('RDB$COLLATION_NAME').AsString), Term,
1155 >                 not (etGrantsToUser in ExtractTypes));
1156 >          qryRoles.Next;
1157 >        end;
1158 >      finally
1159 >        qryRoles.Close;
1160 >      end;
1161 >
1162 >      qryRoles.SQL.Text := ExceptionSQL;
1163 >      qryRoles.ExecQuery;
1164 >      try
1165 >        while not qryRoles.Eof do
1166 >        begin
1167 >          ShowGrants(Trim(qryRoles.FieldByName('RDB$EXCEPTION_NAME').AsString), Term,
1168 >                     not (etGrantsToUser in ExtractTypes));
1169 >          qryRoles.Next;
1170 >        end;
1171 >      finally
1172 >        qryRoles.Close;
1173 >      end;
1174 >
1175 >      qryRoles.SQL.Text := GeneratorSQL;
1176 >      qryRoles.ExecQuery;
1177 >      try
1178 >        while not qryRoles.Eof do
1179 >        begin
1180 >          ShowGrants(Trim(qryRoles.FieldByName('RDB$GENERATOR_NAME').AsString), Term,
1181 >                 not (etGrantsToUser in ExtractTypes));
1182 >          qryRoles.Next;
1183 >        end;
1184 >      finally
1185 >        qryRoles.Close;
1186        end;
1009 –    finally
1010 –      qryRoles.Close;
1187      end;
1188  
1189 <    qryRoles.SQL.Text := GeneratorSQL;
1189 >    qryRoles.SQL.Text := ProcedureSQL;
1190      qryRoles.ExecQuery;
1191      try
1192        while not qryRoles.Eof do
1193        begin
1194 <        ShowGrants(Trim(qryRoles.FieldByName('RDB$GENERATOR_NAME').AsString), Term);
1194 >        ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsString), Term,
1195 >                not (etGrantsToUser in ExtractTypes));
1196          qryRoles.Next;
1197        end;
1198      finally
1199        qryRoles.Close;
1200      end;
1201  
1202 <    qryRoles.SQL.Text := ProcedureSQL;
1203 <    qryRoles.ExecQuery;
1204 <    try
1202 >    {Metadata Grants}
1203 >    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
1204 >    begin
1205 >      qryRoles.SQL.Text := MetadataGrantsSQL;
1206 >      qryRoles.ExecQuery;
1207        while not qryRoles.Eof do
1208        begin
1209 <        ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsString), Term);
1209 >        if (etGrantsToUser in ExtractTypes) or
1210 >           (qryRoles.FieldByName('RDB$USER_TYPE').AsInteger <> obj_user) or
1211 >           (qryRoles.FieldByName('RDB$USER').AsString = 'PUBLIC') then
1212 >        FMetaData.Add(Format('GRANT %s %s TO %s "%s" %s%s', [
1213 >                              qryRoles.FieldByName('Privilege').AsString,
1214 >                              qryRoles.FieldByName('METAOBJECTNAME').AsString,
1215 >                              qryRoles.FieldByName('USER_TYPE_NAME').AsString,
1216 >                              qryRoles.FieldByName('RDB$USER').AsString,
1217 >                              qryRoles.FieldByName('GRANTOPTION').AsString,
1218 >                              Term]));
1219          qryRoles.Next;
1220        end;
1033 –    finally
1221        qryRoles.Close;
1222      end;
1223    finally
# Line 1303 | Line 1490 | begin
1490        SList.Add(Format('CREATE TRIGGER %s%s%s %s POSITION %d',
1491                  [QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1492                  LineEnding, InActive,
1493 <                GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger),
1493 >                GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInt64),
1494                  qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1495  
1496        if RelationName <> '' then
# Line 2614 | Line 2801 | end;
2801  
2802   procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2803   begin
2804 <  if FDatabase <> Value then
2804 >  if (csLoading in ComponentState) or (FDatabase <> Value) then
2805    begin
2806      FDatabase := Value;
2807      if (not Assigned(FTransaction)) and (FDatabase <> nil) then
# Line 2646 | Line 2833 | begin
2833    end;
2834    FMetaData.Clear;
2835    case ObjectType of
2836 <    eoDatabase : ExtractDDL(true, '', etData in ExtractTypes);
2836 >    eoDatabase : ExtractDDL(true, '', ExtractTypes);
2837      eoDomain :
2838        if etTable in ExtractTypes then
2839          ListDomains(ObjectName, etTable)
# Line 2706 | Line 2893 | begin
2893      eoGenerator : ListGenerators(ObjectName,ExtractTypes);
2894      eoException : ListException(ObjectName);
2895      eoBLOBFilter : ListFilters(ObjectName);
2896 <    eoRole : ListRoles(ObjectName);
2896 >    eoRole : ListRoles(ObjectName,etGrant in ExtractTypes);
2897      eoTrigger :
2898        if etTable in ExtractTypes then
2899        begin
# Line 2807 | Line 2994 | end;
2994     Grant various privileges to procedures.
2995     All privileges may have the with_grant option set. }
2996  
2997 < procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String);
2997 > procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String;
2998 >  NoUserGrants: boolean);
2999   const
3000    GrantsBaseSelect =
3001 <  'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
3002 <  'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
3003 <  'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
3004 <  'case  RDB$OBJECT_TYPE '+
3005 <  'When 0 then ''TABLE'' '+
3006 <  'When 5 then ''PROCEDURE'' '+
3007 <  'When 7 then ''EXCEPTION'' '+
3008 <  'When 11 then ''CHARACTER SET'' '+
3009 <  'When 14 then ''GENERATOR'' '+
3010 <  'ELSE NULL END as OBJECT_TYPE_NAME, '+
3011 <  'case RDB$USER_TYPE '+
3012 <  'When 5 then ''PROCEDURE'' '+
3013 <  'When 2 then ''TRIGGER'' '+
3014 <  'When 8 then ''USER'' '+
3015 <  'When 13 then ''ROLE'' '+
3016 <  'ELSE NULL END as USER_TYPE_NAME, '+
3017 <  'case '+
3018 <  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
3019 <  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
3020 <  'ELSE '''' End as GRANTOPTION '+
3021 <  'From (  '+
3022 <  'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
3023 <  'When ''X'' then ''EXECUTE''  '+
3024 <  'When ''S'' then ''SELECT''  '+
3025 <  'When ''U'' then ''UPDATE''   '+
3026 <  'When ''D'' then ''DELETE''  '+
3027 <  'When ''R'' then ''REFERENCES''  '+
3028 <  'When ''G'' then ''USAGE''  '+
3029 <  'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
3030 <  'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME  '+
3031 <  'FROM RDB$USER_PRIVILEGES PR  '+
3032 <  'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
3033 <  'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
3034 <  'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME  '+
3035 <  'UNION  '+
3036 <  'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
3037 <  'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME   '+
3038 <  'FROM RDB$USER_PRIVILEGES PR  '+
3039 <  'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
3040 <  'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
3041 <  'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME)  '+
2854 <  'Where METAOBJECTNAME = :METAOBJECTNAME and RDB$USER <> RDB$OWNER_NAME  '+
2855 <  'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE,METAOBJECTNAME '+
2856 <  'ORDER BY RDB$USER, RDB$OBJECT_TYPE';
3001 >    'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges,  '+
3002 >    'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME,  '+
3003 >    'RDB$USER_TYPE, RDB$OBJECT_TYPE,  '+
3004 >    'case T2.RDB$TYPE_NAME  '+
3005 >    '  When ''RELATION'' then ''TABLE''  '+
3006 >    '  When ''FIELD'' then ''DOMAIN''  '+
3007 >    'Else T2.RDB$TYPE_NAME End as OBJECT_TYPE_NAME,  '+
3008 >    'T1.RDB$TYPE_NAME as USER_TYPE_NAME,  '+
3009 >    'case  '+
3010 >    'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION''  '+
3011 >    'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION''  '+
3012 >    'ELSE '''' End as GRANTOPTION,  '+
3013 >    'case When RDB$OWNER_NAME = RDB$GRANTOR then '''' '+
3014 >    'else coalesce('' GRANTED BY "'' || Trim(RDB$GRANTOR) || ''"'','''') END as GRANTEDBY  '+
3015 >    'From (   '+
3016 >    'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE   '+
3017 >    'When ''X'' then ''EXECUTE''   '+
3018 >    'When ''S'' then ''SELECT''   '+
3019 >    'When ''U'' then ''UPDATE''    '+
3020 >    'When ''D'' then ''DELETE''   '+
3021 >    'When ''R'' then ''REFERENCES''   '+
3022 >    'When ''G'' then ''USAGE''   '+
3023 >    'When ''I'' then ''INSERT''  '+
3024 >    'end )) as "Privileges",   '+
3025 >    'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME,PR.RDB$GRANTOR   '+
3026 >    'FROM RDB$USER_PRIVILEGES PR   '+
3027 >    'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE  '+
3028 >    'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)   '+
3029 >    'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME,PR.RDB$GRANTOR   '+
3030 >    'UNION   '+
3031 >    'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',   '+
3032 >    'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME,PR.RDB$GRANTOR    '+
3033 >    'FROM RDB$USER_PRIVILEGES PR   '+
3034 >    'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE  '+
3035 >    'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null    '+
3036 >    'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME,PR.RDB$GRANTOR) A '+
3037 >    'JOIN RDB$TYPES T1 On T1.RDB$TYPE = RDB$USER_TYPE and T1.RDB$FIELD_NAME = ''RDB$OBJECT_TYPE''  '+
3038 >    'JOIN RDB$TYPES T2 On T2.RDB$TYPE = RDB$OBJECT_TYPE and T2.RDB$FIELD_NAME = ''RDB$OBJECT_TYPE''  '+
3039 >    'Where METAOBJECTNAME = :METAOBJECTNAME and RDB$USER <> RDB$OWNER_NAME   '+
3040 >    'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE,METAOBJECTNAME,RDB$GRANTOR,T2.RDB$TYPE_NAME,T1.RDB$TYPE_NAME,RDB$OWNER_NAME  '+
3041 >    'ORDER BY RDB$USER, RDB$OBJECT_TYPE';
3042  
3043    GrantsSQL12 =
3044 <  'with ObjectOwners As ( '+
3045 <  'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
3046 <  'From RDB$RELATIONS '+
3047 <  'UNION '+
3048 <  'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
3049 <  'From RDB$PROCEDURES '+
3050 <  'UNION '+
3051 <  'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 7 as ObjectType '+
3052 <  'From RDB$EXCEPTIONS '+
3053 <  'UNION '+
3054 <  'Select RDB$GENERATOR_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 14 as ObjectType '+
3055 <  'From RDB$GENERATORS '+
3056 <  'UNION '+
3057 <  'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 11 as ObjectType '+
3058 <  'From RDB$CHARACTER_SETS '+
3044 >  'with ObjectOwners As (  '+
3045 >  '  Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType  '+
3046 >  '  From RDB$RELATIONS  '+
3047 >  '  UNION  '+
3048 >  '  Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType  '+
3049 >  '  From RDB$PROCEDURES  '+
3050 >  '  UNION  '+
3051 >  '  Select RDB$EXCEPTION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 7 as ObjectType  '+
3052 >  '  From RDB$EXCEPTIONS  '+
3053 >  '  UNION  '+
3054 >  '  Select RDB$FIELD_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 9 as ObjectType  '+
3055 >  '  From RDB$FIELDS Where RDB$FIELD_NAME not Similar to ''RDB$%|SEC$%|MON$%|SQL$%'' '+
3056 >  '  UNION  '+
3057 >  '  Select RDB$GENERATOR_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 14 as ObjectType  '+
3058 >  '  From RDB$GENERATORS  '+
3059 >  '  UNION  '+
3060 >  '  Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 11 as ObjectType  '+
3061 >  '  From RDB$CHARACTER_SETS  '+
3062 >  '  UNION  '+
3063 >  '  Select RDB$COLLATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 17 as ObjectType  '+
3064 >  '  From RDB$COLLATIONS  '+
3065    ') '+ GrantsBaseSelect;
3066  
3067    GrantsSQL =
# Line 2907 | Line 3098 | begin
3098      qryOwnerPriv.ExecQuery;
3099      while not qryOwnerPriv.Eof do
3100      begin
3101 <      FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
3101 >      if not NoUserGrants or (qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger <> obj_user)
3102 >          or (qryOwnerPriv.FieldByName('RDB$USER').AsString = 'PUBLIC') then
3103 >      FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s%s', [
3104                              qryOwnerPriv.FieldByName('Privileges').AsString,
3105                              qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
3106                              qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
3107                              qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
3108                              qryOwnerPriv.FieldByName('RDB$USER').AsString,
3109                              qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
3110 +                            qryOwnerPriv.FieldByName('GRANTEDBY').AsString,
3111                              Terminator]));
3112        qryOwnerPriv.Next;
3113      end;
# Line 3241 | Line 3435 | begin
3435        Database := FDatabase;
3436        SQL.Text := TableSQL;
3437        ExecQuery;
3438 +      FMetaData.Add('/* Data Starts */');
3439        while not EOF do
3440        begin
3441          ListData(Trim(FieldByName('RDB$RELATION_NAME').AsString));
3442          Next;
3443        end;
3444 +      FMetaData.Add('/* Data Ends */');
3445      finally
3446        Free;
3447      end;
# Line 3272 | Line 3468 | begin
3468      with TIBInsertStmtsOut.Create(self) do
3469      try
3470        Database := FDatabase;
3471 <      DataOut(Format('Select %s From %s',[FieldList,QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]),
3472 <                Add2MetaData);
3473 <      FMetaData.Add('COMMIT;');
3471 >      if DataOut(Format('Select %s From %s',[FieldList,QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]),
3472 >                Add2MetaData) then
3473 >        FMetaData.Add('COMMIT;');
3474      finally
3475        Free
3476      end;
3477    end;
3478   end;
3479  
3480 < procedure TIBExtract.ListRoles(ObjectName: String);
3480 > procedure TIBExtract.ListRoles(ObjectName: String; IncludeGrants: boolean);
3481   const
3482    RolesSQL =
3483      'select * from RDB$ROLES WHERE RDB$SYSTEM_FLAG = 0 ' +
# Line 3328 | Line 3524 | begin
3524              PrevOwner := OwnerName;
3525            end;
3526            FMetaData.Add('CREATE ROLE ' + RoleName + Term);
3527 +          if IncludeGrants then
3528 +            ShowGrantsTo(qryRoles.FieldByName('rdb$Role_Name').AsString,obj_sql_role,Term);
3529            qryRoles.Next;
3530          end;
3531        finally

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines