1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:

unit FilePerm;

(*
  Nicht-visuelle Klasse
    - Lesen und Ändern von Dateizugriffsrechten
    - Lesen und Ändern des Besitzers und der Gruppe
    - Feststellen des Datei-Types (siehe TFileType)

  Fragen, Berichtigungen und Anregungen bitte direkt an

    peter-gaede@t-online.de

  schicken.

  Beispiel Lesen:
    var
      FP: TFilePerm;
    begin
      FP := TFilePerm.Create(FILENAME);
      ...
        Auslesen der Properties
      ...
      FP.Free;
    end;

  Beispiel Setzen der Zugriffsrechte:
    var
      FP: TFilePerm;
    begin
      FP := TFilePerm.Create(FILENAME);
      ...
        Setzen der Properties (ausser Owner, Group und FileType, da diese Read-Only sind, und FileName ebenfalls nicht)
      ...
      FP.SetFilePerms;
      FP.Free;
    end;

  Beispiel Ändern des Besitzers und/oder der Gruppe:
    var
      FP: TFilePerm;
    begin
      FP := TFilePerm.Create(FILENAME);
      FP.SetOwner(NEW_USER, NEW_GROUP);
      FP.Free;
    end;

*)

interface

type
  TPermsErrorEvent = procedure(AErrorText: String) of Object;

  TFileType = (ftDirectory, ftCharacterDevice, ftBlockDevice, ftRegularFile, ftFIFO,
    ftSymbolicLink, ftSocket, ftUnknown);

  TFilePerm = class
  private
    FFileName: String;
    FOwner: String;
    FGroup: String;
    FFileType: TFileType;
    FSetUID: Boolean;
    FSetGID: Boolean;
    FSticky: Boolean;
    FUserRead: Boolean;
    FUserWrite: Boolean;
    FUserExecute: Boolean;
    FGroupRead: Boolean;
    FGroupWrite: Boolean;
    FGroupExecute: Boolean;
    FAllRead: Boolean;
    FAllWrite: Boolean;
    FAllExecute: Boolean;

    FOnPermsError: TPermsErrorEvent;

    procedure SetFileName(const Value: String);
  protected
    procedure GetFilePermsAndOwner;
    procedure ShowError;
  public
    constructor Create(AFileName: String);

    procedure SetFilePerms;
    procedure SetOwner(AUser, AGroup: String);

    property FileName: String read FFileName write SetFileName;
    property Owner: String read FOwner;
    property Group: String read FGroup;
    property FileType: TFileType read FFileType;
    property SetUID: Boolean read FSetUID write FSetUID;
    property SetGID: Boolean read FSetGID write FSetGID;
    property Sticky: Boolean read FSticky write FSticky;
    property UserRead: Boolean read FUserRead write FUserRead;
    property UserWrite: Boolean read FUserWrite write FUserWrite;
    property UserExecute: Boolean read FUserExecute write FUserExecute;
    property GroupRead: Boolean read FGroupRead write FGroupRead;
    property GroupWrite: Boolean read FGroupWrite write FGroupWrite;
    property GroupExecute: Boolean read FGroupExecute write FGroupExecute;
    property AllRead: Boolean read FAllRead write FAllRead;
    property AllWrite: Boolean read FAllWrite write FAllWrite;
    property AllExecute: Boolean read FAllExecute write FAllExecute;

    property OnPermsError: TPermsErrorEvent read FOnPermsError write FOnPermsError;
  end;

implementation

uses
  QDialogs, Libc;

{ TFilePerm }

constructor TFilePerm.Create(AFileName: String);
begin
  FFileName := AFileName;
  GetFilePermsAndOwner;
end;

procedure TFilePerm.GetFilePermsAndOwner;
var
  r: Integer;
  perms: Cardinal;
  statBuf: TStatBuf;
  passRec: PPasswordRecord;
  groupRec: PGroup;
begin
  FOwner := '';
  FGroup := '';
  FFileType := ftUnknown;
  FSetUID := False;
  FSetGID := False;
  FSticky := False;
  FUserRead := False;
  FUserWrite := False;
  FUserExecute := False;
  FGroupRead := False;
  FGroupWrite := False;
  FGroupExecute := False;
  FAllRead := False;
  FAllWrite := False;
  FAllExecute := False;

  r := stat(PChar(FFileName), statBuf);
  if r = -1 then ShowError
  else
  begin
    perms := statBuf.st_mode;

    if S_ISDIR(statBuf.st_mode) = True then FFileType := ftDirectory
    else if S_ISCHR(statBuf.st_mode) = True then FFileType := ftCharacterDevice
    else if S_ISBLK(statBuf.st_mode) = True then FFileType := ftBlockDevice
    else if S_ISREG(statBuf.st_mode) = True then FFileType := ftRegularFile
    else if S_ISFIFO(statBuf.st_mode) = True then FFileType := ftFIFO
    else if S_ISLNK(statBuf.st_mode) = True then FFileType := ftSymbolicLink
    else if S_ISSOCK(statBuf.st_mode) = True then FFileType := ftSocket;

    FSetUID := ((perms and S_ISUID) <> 0);
    FSetGID := ((perms and S_ISGID) <> 0);
    FSticky := ((perms and S_ISVTX) <> 0);
    FUserRead := ((perms and S_IRUSR) <> 0);
    FUserWrite := ((perms and S_IWUSR) <> 0);
    FUserExecute := ((perms and S_IXUSR) <> 0);
    FGroupRead := ((perms and S_IRGRP) <> 0);
    FGroupWrite := ((perms and S_IWGRP) <> 0);
    FGroupExecute := ((perms and S_IXGRP) <> 0);
    FAllRead := ((perms and S_IROTH) <> 0);
    FAllWrite := ((perms and S_IWOTH) <> 0);
    FAllExecute := ((perms and S_IXOTH) <> 0);

    passRec := getpwuid(statBuf.st_uid);
    FOwner := passRec.pw_name;

    groupRec := getgrgid(statBuf.st_gid);
    FGroup := groupRec.gr_name;
  end;
end;

procedure TFilePerm.SetFileName(const Value: String);
begin
  FFileName := Value;
  GetFilePermsAndOwner;
end;

procedure TFilePerm.SetFilePerms;
var
  r: Integer;
  perms: Cardinal;
begin
  perms := 0;
  if FSetUID then perms := perms or S_ISUID;
  if FSetGID then perms := perms or S_ISGID;
  if FSticky then perms := perms or S_ISVTX;
  if FUserRead then perms := perms or S_IRUSR;
  if FUserWrite then perms := perms or S_IWUSR;
  if FUserExecute then perms := perms or S_IXUSR;
  if FGroupRead then perms := perms or S_IRGRP;
  if FGroupWrite then perms := perms or S_IWGRP;
  if FGroupExecute then perms := perms or S_IXGRP;
  if FAllRead then perms := perms or S_IROTH;
  if FAllWrite then perms := perms or S_IWOTH;
  if FAllExecute then perms := perms or S_IXOTH;

  r := chmod(PChar(FFileName), perms);
  if r = -1 then ShowError;
end;

procedure TFilePerm.SetOwner(AUser, AGroup: String);
var
  r: Integer;
  passRec: PPasswordRecord;
  groupRec: PGroup;
begin
  passRec := getpwnam(PChar(AUser));
  groupRec := getgrnam(PChar(AGroup));

  r := chown(PChar(FFileName), passRec.pw_uid, groupRec.gr_gid);
  if r = -1 then ShowError
  else
  begin
    FOwner := AUser;
    FGroup := AGroup;
  end;
end;

procedure TFilePerm.ShowError;
var
  errBuf: PChar;
begin
  errBuf := StrError(errno);
  if Assigned(FOnPermsError) then FOnPermsError(String(errBuf))
  else MessageDlg('SetFilePerms - Error', String(errBuf), mtError, [mbOK], 0);
end;

end.