Commit e7baa6872c6ab4cfe4be4e93628f0345e934813a

Prepare for IPK1.1 implementation

* Rename and move some files...
  
1===== IPK 1.1 Specification =====
2
3FIXME This specifications are @work! Some information might change due the development process
4or might just be outdated and wrong.
5
6==== General ====
7
8=== Format ===
9
10An IPK setup-package is a [[http://en.wikipedia.org/wiki/Tar_%28file_format%29 | TAR-Archive]],
11containing a [[http://en.wikipedia.org/wiki/Xz | XZ-Compressed]] data and control tarball.
12An IPK-Package has the file extension .ipk (= **I**nstallation **p**ac**k**age), which was choosen because it is
13simple and easy to remember. Unfortunately the Opkg and Ipkg package manager for Linux cellphones uses the same extension,
14(and IPK was an image-format for Nintendo® games), but because Listaller setups are targeted to Linux desktops and not to
15cellphones, this should not leat to much confusion.
16Most of the IPK packages are named in the following pattern: InstallAppname-version_architecture.ipk
17E.g if the name of the application is "Sample" the version is "1.0" and the architecture is "i386" the package should
18be named InstallSample-10_i386.ipk or Sample-10_i386.ipk
19
20=== Structure ===
21
22The IPK archive contains the following files and folders at toplevel:
23
24^ Name ^ Required? ^ Function ^
25| files-<id>.tar.xz | yes | Contains the files which have to be installed. The <id> indicates the profile number. |
26| control.tar.xz | yes | Archive with configuration files of this package, the main config file as well as e.g. Licenses, scripts, descriptions, file-info etc. |
27| _signature.asc | no | A GPG ASC signature of this package. (Only exists if the package is signed) |
28
29
30Listaller will detect automatically if a package is signed and check if the signature on the IPK package is valid.
31
32==== The control files ====
33
34All files configuring the behavior of an IPK package or providing additional information about it are stored
35in the //control.tar.xz// archive.
36
37On toplevel, each control archive has to contain an //arcinfo.pin// document, describing all basic stuff of the package.
38
39=== Arcinfo.pin ===
40
41The //arcinfo.pin// file contains the same information as the definition part in an IPS-script.
42The package builder has changed file paths and removed some unnecessary elements, everything else is the same.
43An //arcinfo.pin// file may look like this:
44<code ips>
45IPK-Standard-Version: 1.0
46
47include:"/stuff/locale/setup-es.mo"
48
49Type: linstall
50Name: FooBar
51Version: 1.0-a
52License: include:"/stuff/COPYING"
53Description: include:"/stuff/desc.txt"
54Icon: /stuff/foobar-icon.png
55SDesc: A new foo-ish bar
56SDesc[de]: Einen neue foo-bar
57Group: Development
58Author: Foobar Project
59Maintainer: Pete Foo (petefoo@example.org)
60Disallow: ioNothing
61Profile[0]: Standard
62AppCMD: $INST/foo/foobar
63Architecture: i386
64DSupport: Ubuntu,openSUSE
65Dependencies:
66 $LIB/libc6.so
67 $LIB/library2.so
68 $LIB/libnagra.so.4
69</code>
70The format of an IPS definition section is described in the IPS specifications.
71The following elements are IPK-specific or have different values:
72
73 * License, Description, Wizimage, Icon: The value has changed, it points now to a file in the IPK package. / is the package root. Licenses are usually saved in /stuff
74 * Include commands have also changed values.
75 * The !-Files part is missing.
76
77@>HERE<@
78
79=== File information ===
80
81The information about installed files is saved in text files which are stored in the /stuff folder.
82Every file has a name following the sheme: fileinfo-.id The is replaced by the profile identification number. E.g. if the identification number is 2 the associated file-info file is named fileinfo-2.id The content of the fileinfo has the following structure:
83<code ips>
84>Destination
85Internal path to file
86MD5-hash
87Internal path to file
88MD5-hash
89...
90</code>
91A fileinfo-file can look like this: (extract)
92<code ips>
93>$INST/Songbird
94/data/Songbird/LICENSE.html
959b5151a0cfec60dbc0c3d548cfa3e713
96/data/Songbird/README.txt
97a92100275b9f71115dbe82a18af61392
98/data/Songbird/TRADEMARK.txt
99c82c36a2843c9ad08c42d7170a9c12d1
100/data/Songbird/songbird
10177e7be1db488bf3c4b5e8abd52d6eb23
102/data/Songbird/application.ini
103ff85febb38852501439ea623725241c0
104>$INST/Songbird/jsmodules
105/data/Songbird/jsmodules/sbLibraryUtils.jsm
106418a7400354cd1176264b5ec79f29be2
107</code>
  
1===== IPK 1.1 Specification =====
2
3FIXME This specifications are @work! Some information might change due the development process
4or might just be outdated and wrong.
5
6==== General ====
7
8=== Format ===
9
10An IPK setup-package is a [[http://en.wikipedia.org/wiki/Tar_%28file_format%29 | TAR-Archive]],
11containing a [[http://en.wikipedia.org/wiki/Xz | XZ-Compressed]] data and control tarball.
12An IPK-Package has the file extension .ipk (= **I**nstallation **p**ac**k**age), which was choosen because it is
13simple and easy to remember. Unfortunately the Opkg and Ipkg package manager for Linux cellphones uses the same extension,
14(and IPK was an image-format for Nintendo® games), but because Listaller setups are targeted to Linux desktops and not to
15cellphones, this should not leat to much confusion.
16Most of the IPK packages are named in the following pattern: InstallAppname-version_architecture.ipk
17E.g if the name of the application is "Sample" the version is "1.0" and the architecture is "i386" the package should
18be named InstallSample-10_i386.ipk or Sample-10_i386.ipk
19
20=== Structure ===
21
22The IPK archive contains the following files and folders at toplevel:
23
24^ Name ^ Required? ^ Function ^
25| files-<id>.tar.xz | yes | Contains the files which have to be installed. The <id> indicates the profile number. |
26| control.tar.xz | yes | Archive with configuration files of this package, the main config file as well as e.g. Licenses, scripts, descriptions, file-info etc. |
27| _signature.asc | no | A GPG ASC signature of this package. (Only exists if the package is signed) |
28
29
30Listaller will detect automatically if a package is signed and check if the signature on the IPK package is valid.
31
32==== The control files ====
33
34All files configuring the behavior of an IPK package or providing additional information about it are stored
35in the //control.tar.xz// archive.
36
37On toplevel, each control archive has to contain an //arcinfo.pin// document, describing all basic stuff of the package.
38
39=== Arcinfo.pin ===
40
41The //arcinfo.pin// file contains the same information as the definition part in an IPS-script.
42The package builder has changed file paths and removed some unnecessary elements, everything else is the same.
43An //arcinfo.pin// file may look like this:
44<code ips>
45IPK-Standard-Version: 1.0
46
47include:"/stuff/locale/setup-es.mo"
48
49Type: linstall
50Name: FooBar
51Version: 1.0-a
52License: include:"/stuff/COPYING"
53Description: include:"/stuff/desc.txt"
54Icon: /stuff/foobar-icon.png
55SDesc: A new foo-ish bar
56SDesc[de]: Einen neue foo-bar
57Group: Development
58Author: Foobar Project
59Maintainer: Pete Foo (petefoo@example.org)
60Disallow: ioNothing
61Profile[0]: Standard
62AppCMD: $INST/foo/foobar
63Architecture: i386
64DSupport: Ubuntu,openSUSE
65Dependencies:
66 $LIB/libc6.so
67 $LIB/library2.so
68 $LIB/libnagra.so.4
69</code>
70The format of an IPS definition section is described in the IPS specifications.
71The following elements are IPK-specific or have different values:
72
73 * License, Description, Wizimage, Icon: The value has changed, it points now to a file in the IPK package. / is the package root. Licenses are usually saved in /stuff
74 * Include commands have also changed values.
75 * The !-Files part is missing.
76
77@>HERE<@
78
79=== File information ===
80
81The information about installed files is saved in text files which are stored in the /stuff folder.
82Every file has a name following the sheme: fileinfo-.id The is replaced by the profile identification number. E.g. if the identification number is 2 the associated file-info file is named fileinfo-2.id The content of the fileinfo has the following structure:
83<code ips>
84>Destination
85Internal path to file
86MD5-hash
87Internal path to file
88MD5-hash
89...
90</code>
91A fileinfo-file can look like this: (extract)
92<code ips>
93>$INST/Songbird
94/data/Songbird/LICENSE.html
959b5151a0cfec60dbc0c3d548cfa3e713
96/data/Songbird/README.txt
97a92100275b9f71115dbe82a18af61392
98/data/Songbird/TRADEMARK.txt
99c82c36a2843c9ad08c42d7170a9c12d1
100/data/Songbird/songbird
10177e7be1db488bf3c4b5e8abd52d6eb23
102/data/Songbird/application.ini
103ff85febb38852501439ea623725241c0
104>$INST/Songbird/jsmodules
105/data/Songbird/jsmodules/sbLibraryUtils.jsm
106418a7400354cd1176264b5ec79f29be2
107</code>
  
2121interface
2222
2323uses
24 MD5, Distri, IPKDef, Classes, Contnrs, FTPSend, LiTypes, LiUtils, MTProcs,
24 MD5, Distri, IPKCDef10, Classes, Contnrs, FTPSend, LiTypes, LiUtils, MTProcs,
2525 PkTypes, Process, RegExpr, BaseUnix, Blcksock, FileUtil, HTTPSend, IniFiles,
26 SysUtils, DepManage, strLocale, IPKPackage, liDBusProc, PackageKit,
26 SysUtils, DepManage, strLocale, IPKPackage11, liDBusProc, PackageKit,
2727 SoftwareDB, LiManageApp;
2828
2929type
  
2020
2121uses
2222 CThreads, Classes, IpkInstall, SysUtils, Controls, LiTypes, LiUtils,
23 LiManageApp, LiUpdateApp, GLib2, softwaredb;
23 LiManageApp, LiUpdateApp, GLib2, SoftwareDB;
2424
2525
2626//////////////////////////////////////////////////////////////////////////////////////
  
2121interface
2222
2323uses
24 ipkdef, Classes, GetText, liTypes, liUtils, MTProcs,
24 IPKCDef10, Classes, GetText, liTypes, liUtils, MTProcs,
2525 PkTypes, Process, FileUtil, IniFiles, SysUtils, strLocale,
2626 liDBusProc, PackageKit, SoftwareDB;
2727
  
2222
2323uses
2424 Blcksock, Classes, Contnrs, FileUtil, FTPSend, HTTPSend, IniFiles,
25 IPKDef, IPKPackage, LiUtils, LiDBusProc, LiTypes, MD5, Process,
25 IPKCDef10, IPKPackage11, LiUtils, LiDBusProc, LiTypes, MD5, Process,
2626 SoftwareDB, SysUtils, StrLocale;
2727
2828type
  
2121interface
2222
2323uses
24 MD5, IPKDef, Classes, GPGSign, liTypes,
25 liUtils, Process, RegExpr, FileUtil, SysUtils, IPKPackage, OPBitmapFormats;
24 MD5, IPKCDef10, Classes, GPGSign, LiTypes,
25 LiUtils, Process, RegExpr, FileUtil, SysUtils, IPKPackage11, OPBitmapFormats;
2626
2727type
2828
  
5454 <SearchPaths>
5555 <IncludeFiles Value="$(ProjOutDir)/"/>
5656 <Libraries Value="$(ProjOutDir)/"/>
57 <OtherUnitFiles Value="../;../../opbitmap/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/nogui/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/"/>
57 <OtherUnitFiles Value="../;../bind/;../../opbitmap/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/nogui/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/"/>
5858 <UnitOutputDirectory Value="../../build/$(TargetCPU)-$(TargetOS)"/>
5959 <LCLWidgetType Value="nogui"/>
6060 </SearchPaths>
  
5555 i: Integer;
5656 x: Boolean;
5757 pki: TPackInfo;
58 ErrorMsg: String;
5859begin
5960 // quick check parameters
60 ErrorMsg:=CheckOptions('h?b:uv',['help', 'build:', 'gen-update', 'version', 'noquietcrash', 'deb', 'rpm', 'dpack',
61 ErrorMsg := CheckOptions('h?b:uv',['help', 'build:', 'gen-update', 'version', 'noquietcrash', 'deb', 'rpm', 'dpack',
6162 'generate-button', 'sign']);
62 if ErrorMsg<>'' then
63 if ErrorMsg <> '' then
6364 begin
6465 writeLn(ErrorMsg);
6566 Terminate;
  
2626 Classes, SysUtils, CustApp,
2727 Process, liUtils, LiInstaller,
2828 StrLocale, IniFiles, Distri,
29 LiTranslator, IPKdef, GExt,
30 LiAppMgr, liTypes, Forms;
29 LiTranslator, IPKCDef10, GExt,
30 LiAppMgr, LiTypes, Forms;
3131
3232type
3333
134134 cnf: TIniFile;
135135begin
136136 // quick check parameters
137 ErrorMsg:=CheckOptions('h?b:uvs:i:',['help', 'build:', 'gen-update', 'version', 'noquietcrash', 'deb', 'rpm', 'dpack',
137 ErrorMsg := CheckOptions('h?b:uvs:i:',['help', 'build:', 'gen-update', 'version', 'noquietcrash', 'deb', 'rpm', 'dpack',
138138 'generate-button', 'sign', 'solve', 'testmode', 'install:', 'verbose', 'checkapps']);
139 if ErrorMsg<>'' then
139 if ErrorMsg <> '' then
140140 begin
141141 writeLn(ErrorMsg);
142142 Terminate;
  
2121interface
2222
2323uses
24 Classes, SysUtils, liUtils, ipkdef, ipkbuild, Process;
24 Classes, SysUtils, LiUtils, IPKCDef10, IPKBuild, Process;
2525
2626function ReadInformation(fips: String): TPackInfo;
2727procedure CreateDEB(pk: TPackInfo);
  
161161 size = 48;
162162begin
163163 Items.Add(' ');
164
165164 new := TAppInfoItem.Create;
166165 new.Name := ai.Name;
167166 new.Author := ai.Author;
  
9191 <Libraries Value="$(ProjOutDir)/"/>
9292 <OtherUnitFiles Value="../;../bind/"/>
9393 <UnitOutputDirectory Value="../../build/$(TargetCPU)-$(TargetOS)"/>
94 <LCLWidgetType Value="gtk2"/>
94 <LCLWidgetType Value="qt"/>
9595 </SearchPaths>
9696 <CodeGeneration>
9797 <SmartLinkUnit Value="True"/>
  
2222
2323uses
2424 Spin, Forms, Menus, LiAppMgr, Distri, AppItem, AppList, GLib2,
25 Buttons, Classes, Dialogs, LCLType, liTypes, liUtils, Process, AboutBox,
26 CheckLst, ComCtrls, Controls, ExtCtrls, FileUtil, Graphics, Inifiles, StdCtrls,
25 Buttons, Classes, Dialogs, LCLType, LiTypes, LiUtils, Process, AboutBox,
26 CheckLst, ComCtrls, Controls, ExtCtrls, FileUtil, Graphics, IniFiles, StdCtrls,
2727 SysUtils, StrLocale, Uninstall, IconLoader, LResources, PackageKit, PkTypes;
2828
2929type
200200 Result := true;
201201 with MnFrm do
202202 begin
203 currAppList.ItemFromAppInfo(TAppInfo(obj^));
203 currAppList.ItemFromAppInfo(obj^);
204204 end;
205205 Application.ProcessMessages;
206206end;
  
1{ Copyright (C) 2008-2010 Matthias Klumpp
2
3 Authors:
4 Matthias Klumpp
5
6 This unit is free software: you can redistribute it and/or modify it under
7 the terms of the GNU General Public License as published by the Free Software
8 Foundation, version 3.
9
10 This unit is distributed in the hope that it will be useful, but WITHOUT
11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License v3
15 along with this unit. If not, see <http://www.gnu.org/licenses/>.}
16//** Contains classes to process IPK control and script files (version 1.0)
17unit ipkcdef10;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24 Classes, GetText, liTypes, liUtils, SysUtils, FileUtil;
25
26type
27
28 //** Basic IPK reader class
29 TIPKBasic = class
30 private
31 function GetValue(s: String): String;
32 function SearchKeyIndex(s: String; localized: Boolean = true): Integer;
33 function SolveInclude(s: String): String;
34 function translate(s: String): String;
35 procedure WriteEntry(k, s: String);
36
37 procedure WriteType(atype: TPkgType);
38 function ReadType: TPkgType;
39 procedure WriteName(s: String);
40 function ReadName: String;
41 procedure WriteVersion(s: String);
42 function ReadVersion: String;
43 procedure WriteIcon(s: String);
44 function ReadIcon: String;
45 procedure WriteSDesc(s: String);
46 function ReadSDesc: String;
47 procedure WriteCategory(g: AppCategory);
48 function ReadCategory: AppCategory;
49 procedure WriteAuthor(s: String);
50 function ReadAuthor: String;
51 procedure WriteMaintainer(s: String);
52 function ReadMaintainer: String;
53 procedure WriteDisallows(s: String);
54 function ReadDisallows: String;
55 procedure WriteAppCMD(s: String);
56 function ReadAppCMD: String;
57 procedure WriteArchs(s: String);
58 function ReadArchs: String;
59 procedure WritePkgName(s: String);
60 function ReadPkgName: String;
61 procedure WriteIPKName(s: String);
62 function ReadIPKName: String;
63 procedure WriteDSupport(s: String);
64 function ReadDSupport: String;
65 procedure WriteWizImage(s: String);
66 function ReadWizImage: String;
67 procedure WriteBinary(s: String);
68 function ReadBinary: String;
69 procedure WriteUSource(s: String);
70 function ReadUSource: String;
71 procedure WriteDesktopFiles(s: String);
72 function ReadDesktopFiles: String;
73 procedure WriteInTerminal(b: Boolean);
74 function ReadInTerminal: Boolean;
75 protected
76 text: TStringList;
77 FBasePath: String;
78 clang: String;
79 motrans: Boolean;
80 mofile: String;
81 procedure WriteField(Name: String; info: TStrings);
82 procedure ReadField(Name: String; info: TStrings);
83 public
84 constructor Create;
85 destructor Destroy; override;
86
87 property BasePath: String read FBasePath write FBasePath;
88 property SType: TPkgType read ReadType write WriteType;
89 property AppName: String read ReadName write WriteName;
90 property AppVersion: String read ReadVersion write WriteVersion;
91 procedure ReadAppLicense(info: TStringList);
92 procedure WriteAppLicense(path: String);
93 procedure WriteAppLicense(info: TStringList);
94 procedure ReadAppDescription(info: TStringList);
95 procedure WriteAppDescription(path: String);
96 procedure WriteAppDescription(info: TStringList);
97 property Icon: String read ReadIcon write WriteIcon;
98 property LangCode: String read clang write clang;
99 property SDesc: String read ReadSDesc write WriteSDesc;
100 property Category: AppCategory read ReadCategory write WriteCategory;
101 property Author: String read ReadAuthor write WriteAuthor;
102 property Maintainer: String read ReadMaintainer write WriteMaintainer;
103 property Disallows: String read ReadDisallows write WriteDisallows;
104 procedure ReadProfiles(lst: TStrings);
105 procedure WriteProfiles(lst: TStrings);
106 procedure ReadBuildCMDs(lst: TStrings);
107 procedure WriteBuildCMDs(lst: TStrings);
108 property AppCMD: String read ReadAppCMD write WriteAppCMD;
109 property Architecture: String read ReadArchs write WriteArchs;
110 property PkName: String read ReadPkgName write WritePkgName;
111 property IPKName: String read ReadIPKName write WriteIPKName;
112 property DSupport: String read ReadDSupport write WriteDSupport;
113 property WizImage: String read ReadWizImage write WriteWizImage;
114 property Binary: String read ReadBinary write WriteBinary;
115 property USource: String read ReadUSource write WriteUSource;
116 property Desktopfiles: String read ReadDesktopFiles write WriteDesktopFiles;
117 property InTerminal: Boolean read ReadInTerminal write WriteInTerminal;
118 procedure ReadDependencies(dname: String; info: TStringList);
119 procedure WriteDependencies(dname: String; path: String);
120 procedure WriteDependencies(dname: String; info: TStringList);
121 function LoadFromFile(s: String): Boolean; virtual; abstract;
122 property UseMoTranslation: Boolean read motrans write motrans;
123 procedure GetMoFileList(list: TStringList);
124 procedure SetMoFilesToDir(dir: String);
125 end;
126
127 TIPKControl = class;
128
129 //** Class to handle IPK scripts
130 TIPKScript = class(TIPKBasic)
131 private
132 fname: String;
133 public
134 constructor Create;
135 destructor Destroy; override;
136
137 function SaveToFile(s: String): Boolean;
138 function LoadFromFile(s: String): Boolean; override;
139 function LoadFromList(lst: TStrings): Boolean;
140 procedure GetFiles(id: Integer; lst: TStrings);
141 procedure GetDirectFileList(id: Integer; lst: TStrings);
142 function FinalizeToControl: TIPKControl;
143 end;
144
145 //** Class to read IPK control files
146 TIPKControl = class(TIPKBasic)
147 private
148 fname: String;
149 public
150 constructor Create;
151 constructor Create(path: String);
152 destructor Destroy; override;
153
154 function SaveToFile(s: String): Boolean;
155 procedure GetInternalFilesSection(lst: TStrings);
156 function LoadFromFile(s: String): Boolean; override;
157
158 property RawText: TStringList read text write text;
159 end;
160
161implementation
162
163{ TIPKBasic }
164
165constructor TIPKBasic.Create;
166begin
167 inherited;
168 Text := TStringList.Create;
169 FBasePath := ExtractFilePath(ParamStr(0));
170 clang := '';
171 mofile := '';
172 motrans := false;
173end;
174
175destructor TIPKBasic.Destroy;
176begin
177 Text.Free;
178 inherited;
179end;
180
181procedure TIPKBasic.WriteEntry(k, s: String);
182begin
183 s := k + ': ' + s;
184 if SearchKeyIndex(k) > -1 then
185 Text[SearchKeyIndex(k)] := s
186 else
187 Text.Add(s);
188end;
189
190function TIPKBasic.GetValue(s: String): String;
191begin
192 if pos(':', s) = length(s) then
193 begin
194 //There is an empty block (without value)
195 Result := '';
196 exit;
197 end;
198 Result := copy(s, pos(':', s) + 1, length(s));
199 if (Result[1] = ' ') then
200 Result := copy(Result, 2, length(Result));
201end;
202
203function TIPKBasic.SearchKeyIndex(S: String; localized: Boolean = true): Integer;
204var
205 i: Integer;
206 h: String;
207begin
208 Result := -1;
209 i := Text.Count;
210 //First search for localized entry
211 if (clang <> '') and (localized) then
212 begin
213 for i := 0 to Text.Count - 1 do
214 begin
215 if (length(Text[i])>0)and(Text[i][1]<>'#')and(Text[i][1]<>' ') then
216 begin
217 h := copy(Text[i], 0, pos(':', Text[i]) - 1);
218 if LowerCase(h) = LowerCase(s) + '[' + clang + ']' then
219 begin
220 Result := i;
221 break;
222 end;
223 end;
224 end;
225 end;
226 //Then search the general key
227 if (not localized) or (Result < 0) then
228 for i := 0 to Text.Count - 1 do
229 begin
230 if (length(Text[i])>0)and(Text[i][1]<>'#')and(Text[i][1]<>' ') then
231 begin
232 h := copy(Text[i], 0, pos(':', Text[i]) - 1);
233 if LowerCase(h) = LowerCase(s) then
234 begin
235 Result := i;
236 break;
237 end;
238 end;
239 end;
240end;
241
242function TIPKBasic.SolveInclude(s: String): String;
243var
244 h: String;
245begin
246 h := copy(s, pos('"', s) + 1, length(s));
247 h := copy(h, 0, pos('"', h) - 1);
248 if not FilenameIsAbsolute(h) then
249 Result := AppendPathDelim(FBasePath) + h
250 else
251 Result := h;
252end;
253
254function TIPKBasic.Translate(s: String): String;
255var
256 i: Integer;
257 mo: TMoFile;
258begin
259 Result := s;
260 if mofile = '~' then
261 exit;
262 if mofile = '' then
263 begin
264 mofile := '~';
265 for i := 0 to text.Count - 1 do
266 if pos('include:', Text[i]) > 0 then
267 if LowerCase(ExtractFileExt(SolveInclude(Text[i]))) = '.mo' then
268 begin
269 mofile := ExtractFileName(SolveInclude(Text[i]));
270 if (mofile = GetLangId + '.mo') or
271 (copy(mofile, pos('-', mofile) + 1, length(mofile)) = GetlangId + '.mo') then
272 break
273 else
274 mofile := '~';
275 end;
276 end;
277 if (mofile = '~') or (trim(mofile) = '') or (not FileExists(FBasePath+mofile)) then
278 exit;
279 mo := TMoFile.Create(FBasePath+mofile);
280 Result := mo.Translate(s);
281 mo.Free;
282end;
283
284procedure TIPKBasic.GetMoFileList(list: TStringList);
285var
286 i: Integer;
287begin
288 for i := 0 to Text.Count - 1 do
289 if pos('include:', Text[i]) > 0 then
290 begin
291 if (ExtractFileExt(SolveInclude(text[i]))) = '.mo' then
292 list.Add(SolveInclude(text[i]));
293 end;
294end;
295
296procedure TIPKBasic.SetMoFilesToDir(dir: String);
297var
298 list: TStringList;
299 i: Integer;
300begin
301 list := TStringList.Create;
302 GetMoFileList(list);
303 i := 0;
304 while i < text.Count do
305 begin
306 if (pos('include:', text[i])>0) and(pos('.mo', text[i])>0) then
307 begin
308 text.Delete(i);
309 end
310 else
311 Inc(i);
312 end;
313 text.Insert(1, '');
314 for i := 0 to list.Count-1 do
315 text.Insert(1, 'include:"'+dir+'/'+ExtractFileName(list[i])+'"');
316 list.Free;
317end;
318
319procedure TIPKBasic.WriteField(Name: String; info: TStrings);
320var
321 i: Integer;
322begin
323 if info.Count >= 0 then
324 begin
325 i := SearchKeyIndex(Name);
326 if i > 0 then
327 begin
328
329 Text.Delete(i);
330 while (i < Text.Count) and (Text[i] <> '') and (Text[i][1] = ' ') do
331 Text.Delete(i);
332 end;
333
334 Text.Add(Name + ': ' + info[0]);
335 for i := 1 to info.Count - 1 do
336 Text.Add(' ' + info[i]);
337 end;
338end;
339
340procedure TIPKBasic.ReadField(Name: String; info: TStrings);
341var
342 i: Integer;
343 s: String;
344begin
345 i := SearchKeyIndex(Name);
346 s := '';
347 if i > -1 then
348 s := Text[i];
349 info.Clear;
350 if s = '' then
351 exit;
352 if pos('include:"', s) > 0 then
353 info.LoadFromFile(SolveInclude(s))
354 else
355 begin
356 info.Add(GetValue(Text[i]));
357 Inc(i);
358 if i < Text.Count then
359 repeat
360 s := Text[i];
361 if s[1] = ' ' then
362 begin
363 s := copy(s, 2, length(s));
364 info.Add(s);
365 end;
366 Inc(i);
367 until (i >= Text.Count) or (Text[i][1] <> ' ') or (length(Text[i]) < 1);
368 end;
369end;
370
371procedure TIPKBasic.WriteType(atype: TPkgType);
372var
373 h: String;
374begin
375 case AType of
376 ptLinstall: h := 'Type: linstall';
377 ptDLink: h := 'Type: dlink';
378 ptContainer: h := 'Type: container';
379 end;
380 if SearchKeyIndex('Type', false) > -1 then
381 Text[SearchKeyIndex('Type', false)] := h
382 else
383 Text.Add(h);
384end;
385
386function TIPKBasic.ReadType: TPkgType;
387var
388 s: String;
389 j: Integer;
390begin
391 Result := ptUnknown;
392 j := SearchKeyIndex('Type', false);
393
394 if j > -1 then
395 begin
396 s := Text[j];
397 writeLn(s);
398 if GetValue(s) = 'linstall' then
399 Result := ptLinstall;
400 if GetValue(s) = 'dlink' then
401 Result := ptDLink;
402 if GetValue(s) = 'container' then
403 Result := ptContainer;
404 end;
405end;
406
407procedure TIPKBasic.WriteName(s: String);
408var
409 k: String;
410begin
411 if clang = '' then
412 k := 'Name'
413 else
414 k := 'Name[' + clang + ']';
415
416 WriteEntry(k, s);
417end;
418
419function TIPKBasic.ReadName: String;
420var
421 j: Integer;
422begin
423 Result := '';
424 j := SearchKeyIndex('Name');
425 if j > -1 then
426 Result := GetValue(Text[j]);
427 Result := translate(Result);
428end;
429
430procedure TIPKBasic.WriteVersion(s: String);
431var
432 k: String;
433begin
434 if clang = '' then
435 k := 'Version'
436 else
437 k := 'Version[' + clang + ']';
438
439 WriteEntry(k, s);
440end;
441
442function TIPKBasic.ReadVersion: String;
443var
444 j: Integer;
445begin
446 Result := '';
447 j := SearchKeyIndex('Version');
448 if j > -1 then
449 Result := GetValue(Text[j]);
450end;
451
452procedure TIPKBasic.ReadAppLicense(info: TStringList);
453begin
454 ReadField('License', info);
455end;
456
457procedure TIPKBasic.WriteAppLicense(path: String);
458var
459 s: String;
460 i: Integer;
461begin
462 s := 'License: include:"' + path + '"';
463
464 i := SearchKeyIndex('License');
465 if i > 0 then
466 begin
467 Text.Delete(i);
468 while (i < Text.Count) and (Text[i][1] = ' ') do
469 Text.Delete(i);
470 end;
471
472 if i > -1 then
473 Text[i] := s
474 else
475 Text.Add(s);
476end;
477
478procedure TIPKBasic.WriteAppLicense(info: TStringList);
479begin
480 WriteField('License', info);
481end;
482
483procedure TIPKBasic.ReadAppDescription(info: TStringList);
484begin
485 ReadField('Description', info);
486end;
487
488procedure TIPKBasic.WriteAppDescription(path: String);
489var
490 s: String;
491 i: Integer;
492begin
493 s := 'Description: include:"' + path + '"';
494
495 i := SearchKeyIndex('Description');
496 if i > 0 then
497 begin
498 Text.Delete(i);
499 while (i < Text.Count) and (Text[i][1] = ' ') do
500 Text.Delete(i);
501 end;
502
503 if i > -1 then
504 Text[i] := s
505 else
506 Text.Add(s);
507end;
508
509procedure TIPKBasic.WriteAppDescription(info: TStringList);
510begin
511 WriteField('Description', info);
512end;
513
514procedure TIPKBasic.WriteIcon(s: String);
515begin
516 WriteEntry('Icon', s);
517end;
518
519function TIPKBasic.ReadIcon: String;
520var
521 j: Integer;
522begin
523 Result := '';
524 j := SearchKeyIndex('Icon', false);
525 if j > -1 then
526 Result := GetValue(Text[j]);
527end;
528
529procedure TIPKBasic.WriteSDesc(s: String);
530var
531 k: String;
532begin
533 if clang = '' then
534 k := 'SDesc'
535 else
536 k := 'SDesc[' + clang + ']';
537
538 WriteEntry(k, s);
539end;
540
541function TIPKBasic.ReadSDesc: String;
542var
543 j: Integer;
544begin
545 Result := '';
546 j := SearchKeyIndex('SDesc');
547 if j > -1 then
548 Result := GetValue(Text[j]);
549
550 Result := translate(Result);
551end;
552
553procedure TIPKBasic.WriteCategory(g: AppCategory);
554var
555 s: String;
556begin
557 case g of
558 gtALL: s := 'All';
559 gtEDUCATION: s := 'Education';
560 gtOFFICE: s := 'Office';
561 gtDEVELOPMENT: s := 'Development';
562 gtGRAPHIC: s := 'Graphic';
563 gtNETWORK: s := 'Network';
564 gtGAMES: s := 'Games';
565 gtSYSTEM: s := 'System';
566 gtMULTIMEDIA: s := 'Multimedia';
567 gtADDITIONAL: s := 'Additional';
568 gtOTHER: s := 'Other';
569 end;
570 s := 'Group: ' + s;
571
572 if SearchKeyIndex('Group', false) > -1 then
573 Text[SearchKeyIndex('Group', false)] := s
574 else
575 Text.Add(s);
576end;
577
578function TIPKBasic.ReadCategory: AppCategory;
579var
580 j: Integer;
581 s: String;
582begin
583 Result := gtUNKNOWN;
584 j := SearchKeyIndex('Group', false);
585 if j > -1 then
586 s := GetValue(Text[j]);
587
588 s := LowerCase(s);
589 if s = 'all' then
590 Result := gtALL;
591 if s = 'education' then
592 Result := gtEDUCATION;
593 if s = 'office' then
594 Result := gtOFFICE;
595 if s = 'development' then
596 Result := gtDEVELOPMENT;
597 if s = 'graphic' then
598 Result := gtGRAPHIC;
599 if s = 'network' then
600 Result := gtNETWORK;
601 if s = 'games' then
602 Result := gtGAMES;
603 if s = 'system' then
604 Result := gtSYSTEM;
605 if s = 'multimedia' then
606 Result := gtMULTIMEDIA;
607 if s = 'additional' then
608 Result := gtADDITIONAL;
609 if s = 'other' then
610 Result := gtOTHER;
611end;
612
613procedure TIPKBasic.ReadBuildCMDs(lst: TStrings);
614begin
615 ReadField('Build', lst);
616end;
617
618procedure TIPKBasic.WriteBuildCMDs(lst: TStrings);
619begin
620 WriteField('Build', lst);
621end;
622
623procedure TIPKBasic.WriteAuthor(s: String);
624var
625 k: String;
626begin
627 if clang = '' then
628 k := 'Author'
629 else
630 k := 'Author[' + clang + ']';
631
632 WriteEntry(k, s);
633end;
634
635function TIPKBasic.ReadAuthor: String;
636var
637 j: Integer;
638begin
639 Result := '';
640 j := SearchKeyIndex('Author');
641 if j > -1 then
642 Result := GetValue(Text[j]);
643 Result := translate(Result);
644end;
645
646procedure TIPKBasic.WriteMaintainer(s: String);
647var
648 k: String;
649begin
650 if clang = '' then
651 k := 'Maintainer'
652 else
653 k := 'Maintainer[' + clang + ']';
654
655 WriteEntry(k, s);
656end;
657
658function TIPKBasic.ReadMaintainer: String;
659var
660 j: Integer;
661begin
662 Result := '';
663 j := SearchKeyIndex('Maintainer');
664 if j > -1 then
665 Result := GetValue(Text[j]);
666 Result := translate(Result);
667end;
668
669procedure TIPKBasic.WriteDisallows(s: String);
670var
671 k: String;
672begin
673 k := 'Disallow';
674 WriteEntry(k, s);
675end;
676
677function TIPKBasic.ReadDisallows: String;
678var
679 j: Integer;
680begin
681 Result := '';
682 j := SearchKeyIndex('Disallow', false);
683 if j > -1 then
684 Result := GetValue(Text[j]);
685end;
686
687procedure TIPKBasic.WriteProfiles(lst: TStrings);
688var
689 k, s: String;
690 i: Integer;
691begin
692 k := 'Profile[';
693 for i := 0 to lst.Count - 1 do
694 begin
695 s := k + IntToStr(i) + ']: ' + lst[i];
696 if SearchKeyIndex(k) > -1 then
697 Text[SearchKeyIndex(k)] := s
698 else
699 Text.Add(s);
700 end;
701end;
702
703procedure TIPKBasic.ReadProfiles(lst: TStrings);
704var
705 j: Integer;
706
707 function GetProfileName(id: Integer): String;
708 var
709 i: Integer;
710 begin
711 Result := '';
712 i := SearchKeyIndex('Profiles[' + IntToStr(id) + ']');
713 if (id = 0) and (i < 0) then
714 i := SearchKeyIndex('Profiles');
715 if i > -1 then
716 Result := GetValue(Text[i]);
717 end;
718
719begin
720 j := 0;
721 repeat
722 lst.Add(GetProfileName(j));
723 Inc(j);
724 until GetProfileName(j) = '';
725end;
726
727procedure TIPKBasic.WriteAppCMD(s: String);
728var
729 k: String;
730begin
731 k := 'AppCMD';
732
733 WriteEntry(k, s);
734end;
735
736function TIPKBasic.ReadAppCMD: String;
737var
738 j: Integer;
739begin
740 Result := '';
741 j := SearchKeyIndex('AppCMD', false);
742 if j > -1 then
743 Result := GetValue(Text[j]);
744end;
745
746procedure TIPKBasic.WriteArchs(s: String);
747var
748 k: String;
749begin
750 k := 'Architecture';
751 WriteEntry(k, s);
752end;
753
754function TIPKBasic.ReadArchs: String;
755var
756 j: Integer;
757begin
758 Result := '';
759 j := SearchKeyIndex('Architecture', false);
760 if j > -1 then
761 Result := GetValue(Text[j]);
762end;
763
764procedure TIPKBasic.WritePkgName(s: String);
765var
766 k: String;
767begin
768 k := 'PkName';
769 WriteEntry(k, s);
770end;
771
772function TIPKBasic.ReadPkgName: String;
773var
774 j: Integer;
775begin
776 Result := '';
777 j := SearchKeyIndex('PkName', false);
778 if j > -1 then
779 Result := GetValue(Text[j]);
780end;
781
782procedure TIPKBasic.WriteIPKName(s: String);
783var
784 k: String;
785begin
786 k := 'IPKName';
787 WriteEntry(k, s);
788end;
789
790function TIPKBasic.ReadIPKName: String;
791var
792 j: Integer;
793begin
794 Result := '';
795 j := SearchKeyIndex('IPKName', false);
796 if j > -1 then
797 Result := GetValue(Text[j]);
798end;
799
800procedure TIPKBasic.WriteDSupport(s: String);
801var
802 k: String;
803begin
804 k := 'DSupport';
805 WriteEntry(k, s);
806end;
807
808function TIPKBasic.ReadDSupport: String;
809var
810 j: Integer;
811begin
812 Result := '';
813 j := SearchKeyIndex('DSupport', false);
814 if j > -1 then
815 Result := GetValue(Text[j]);
816end;
817
818procedure TIPKBasic.ReadDependencies(dname: String; info: TStringList);
819var
820 i: Integer;
821 s: String;
822begin
823 if (dname = 'all') or (dname = '') then
824 i := SearchKeyIndex('Dependencies', false)
825 else
826 i := SearchKeyIndex('Dependencies[' + dname + ']', false);
827
828 s := '';
829 if i > -1 then
830 s := Text[i];
831 info.Clear;
832
833 if s = '' then
834 exit;
835 if pos('include:"', s) > 0 then
836 info.LoadFromFile(SolveInclude(s))
837 else
838 begin
839 info.Add(GetValue(Text[i]));
840 Inc(i);
841 repeat
842 s := Text[i];
843 if length(s) > 0 then
844 if s[1] = ' ' then
845 begin
846 s := copy(s, 2, length(s));
847 info.Add(s);
848 end;
849 Inc(i);
850 until (length(Text[i]) = 0) or (i >= Text.Count) or (Text[i][1] <> ' ');
851 end;
852end;
853
854procedure TIPKBasic.WriteDependencies(dname: String; path: String);
855var
856 s: String;
857 i: Integer;
858begin
859 if (dname = 'all') or (dname = '') then
860 s := 'Dependencies: include:"' + path + '"'
861 else
862 s := 'Dependencies[' + dname + ']: include:"' + path + '"';
863
864 i := SearchKeyIndex('Dependencies');
865 if i > 0 then
866 begin
867 Text.Delete(i);
868 while (i < Text.Count) and (Text[i][1] = ' ') do
869 Text.Delete(i);
870 end;
871
872 if i > -1 then
873 Text[i] := s
874 else
875 Text.Add(s);
876end;
877
878procedure TIPKBasic.WriteDependencies(dname: String; info: TStringList);
879var
880 i: Integer;
881 s: String;
882begin
883 if info.Count >= 0 then
884 begin
885 if (dname = 'all') or (dname = '') then
886 begin
887 s := 'Dependencies';
888 i := SearchKeyIndex(s, false);
889 end
890 else
891 begin
892 s := 'Dependencies[' + dname + ']';
893 i := SearchKeyIndex(s, false);
894 end;
895
896 if i > 0 then
897 begin
898
899 Text.Delete(i);
900 while (i < Text.Count) and (Text[i] <> '') and (Text[i][1] = ' ') do
901 Text.Delete(i);
902 end;
903
904 Text.Add(s + ': ' + info[0]);
905 for i := 1 to info.Count - 1 do
906 Text.Add(' ' + info[i]);
907
908 end;
909end;
910
911procedure TIPKBasic.WriteWizImage(s: String);
912var
913 k: String;
914begin
915 k := 'WizImage';
916 WriteEntry(k, s);
917end;
918
919function TIPKBasic.ReadWizImage: String;
920var
921 j: Integer;
922begin
923 Result := '';
924 j := SearchKeyIndex('WizImage', false);
925 if j > -1 then
926 Result := GetValue(Text[j]);
927end;
928
929procedure TIPKBasic.WriteBinary(s: String);
930begin
931 WriteEntry('Binary', s);
932end;
933
934function TIPKBasic.ReadBinary: String;
935var
936 j: Integer;
937begin
938 Result := '';
939 j := SearchKeyIndex('Binary', false);
940 if j > -1 then
941 Result := GetValue(Text[j]);
942end;
943
944procedure TIPKBasic.WriteUSource(s: String);
945begin
946 WriteEntry('USource', s);
947end;
948
949function TIPKBasic.ReadUSource: String;
950var
951 j: Integer;
952begin
953 Result := '';
954 j := SearchKeyIndex('USource', false);
955 if j > -1 then
956 Result := GetValue(Text[j]);
957end;
958
959procedure TIPKBasic.WriteDesktopFiles(s: String);
960begin
961 WriteEntry('Desktopfiles', s);
962end;
963
964function TIPKBasic.ReadDesktopFiles: String;
965var
966 j: Integer;
967begin
968 Result := '';
969 j := SearchKeyIndex('Desktopfiles', false);
970 if j > -1 then
971 Result := GetValue(Text[j]);
972end;
973
974procedure TIPKBasic.WriteInTerminal(b: Boolean);
975begin
976 if b = true then
977 WriteEntry('Desktopfiles', 'true')
978 else
979 WriteEntry('Desktopfiles', 'false');
980end;
981
982function TIPKBasic.ReadInTerminal: Boolean;
983var
984 j: Integer;
985 s: String;
986begin
987 j := SearchKeyIndex('InTerminal', false);
988 if j > -1 then
989 s := GetValue(Text[j]);
990 if LowerCase(s) = 'true' then
991 Result := true
992 else
993 Result := false;
994end;
995
996{ TIPKScript }
997
998constructor TIPKScript.Create;
999begin
1000 inherited;
1001 Text.Add('IPK-Standard-Version: 1.1');
1002 Text.Add('');
1003 fname := '';
1004end;
1005
1006destructor TIPKScript.Destroy;
1007begin
1008 inherited;
1009end;
1010
1011function TIPKScript.SaveToFile(s: String): Boolean;
1012begin
1013 Result := true;
1014 try
1015 Text.SaveTofile(s);
1016 FBasePath := ExtractFilePath(s);
1017 fname := s;
1018 except
1019 Result := false;
1020 end;
1021end;
1022
1023function TIPKScript.LoadFromFile(s: String): Boolean;
1024begin
1025 Result := true;
1026 if FileExists(s) then
1027 begin
1028 Text.LoadFromFile(s);
1029 if (Text[0] <> 'IPK-Standard-Version: 1.1')
1030 and(Text[0] <> 'IPK-Standard-Version: 1.0') then
1031 begin
1032 Result := false;
1033 Text.Clear;
1034 Text.Add('IPK-Standard-Version: 1.1');
1035 Text.Add('');
1036 exit;
1037 end;
1038 FBasePath := ExtractFilePath(s);
1039 fname := s;
1040 end
1041 else
1042 Result := false;
1043end;
1044
1045function TIPKScript.LoadFromList(lst: TStrings): Boolean;
1046begin
1047 Result := true;
1048 writeLn(lst[0]);
1049 if (lst[0] <> 'IPK-Standard-Version: 1.1')
1050 and(lst[0] <> 'IPK-Standard-Version: 1.0') then
1051 begin
1052 Result := false;
1053 exit;
1054 end
1055 else
1056 Text.Assign(lst);
1057end;
1058
1059function TIPKScript.FinalizeToControl: TIPKControl;
1060var
1061 i: Integer;
1062 cont: TIPKControl;
1063
1064 procedure ProcessLine(ln: String);
1065 begin
1066 if length(ln) > 0 then
1067 begin
1068 if ln[1] = '#' then
1069 exit;
1070 end;
1071
1072 if pos('#', ln) > 0 then
1073 ln := copy(ln, pos('#', ln) + 1, length(ln));
1074
1075 if pos('IPKName:', ln) > 0 then
1076 exit;
1077
1078 cont.RawText.Add(ln);
1079 end;
1080
1081begin
1082 cont := TIPKControl.Create;
1083
1084 for i := 0 to Text.Count - 1 do
1085 if pos('!-Files', Text[i]) <= 0 then
1086 ProcessLine(Text[i]);
1087
1088 Result := cont;
1089end;
1090
1091procedure TIPKScript.GetDirectFileList(id: Integer; lst: TStrings);
1092var
1093 i, j: Integer;
1094 s: String;
1095 fsec: TStringList;
1096begin
1097 fsec := TStringList.Create;
1098 for j := 0 to Text.Count - 1 do
1099 if pos('!-Files ~' + IntToStr(id), Text[j]) > 0 then
1100 break;
1101
1102 for i := j + 1 to Text.Count - 1 do
1103 if pos('!-Files ~', Text[i]) > 0 then
1104 break
1105 else
1106 fsec.Add(Text[i]);
1107
1108 i := 0;
1109 while i < fsec.Count - 1 do
1110 begin
1111
1112 if fsec[i][1] = '>' then
1113 s := copy(fsec[i], 2, length(fsec[i]))
1114 else
1115 begin
1116 if (fsec[i][1] = '/') or (fsec[i][1] = '.') then
1117 begin
1118 lst.Add(s);
1119 if fsec[i][1] = '.' then
1120 lst.Add(FBasePath + fsec[i])
1121 else
1122 lst.Add(fsec[i]);
1123 end;
1124 end;
1125 Inc(i);
1126 end;
1127end;
1128
1129procedure TIPKScript.GetFiles(id: Integer; lst: TStrings);
1130var
1131 i, j: Integer;
1132begin
1133 //Search for container-IPK files section
1134 j := SearchKeyIndex('Files');
1135 if j > -1 then
1136 begin
1137 ReadField('Files', lst);
1138 end
1139 else
1140 begin
1141 //Read normal files section
1142 for j := 0 to Text.Count - 1 do
1143 if pos('!-Files ~' + IntToStr(id), Text[j]) > 0 then
1144 break;
1145
1146 for i := j + 1 to Text.Count - 1 do
1147 if pos('!-Files ~', Text[i]) > 0 then
1148 break
1149 else
1150 lst.Add(Text[i]);
1151 end;
1152end;
1153
1154{ TIPKControl }
1155
1156constructor TIPKControl.Create(path: String);
1157begin
1158 inherited Create;
1159
1160 LoadFromFile(path);
1161 FBasePath := ExtractFilePath(path);
1162
1163 fname := path;
1164end;
1165
1166constructor TIPKControl.Create;
1167begin
1168 inherited Create;
1169 fname := '';
1170 FBasePath := '';
1171end;
1172
1173destructor TIPKControl.Destroy;
1174begin
1175 inherited;
1176end;
1177
1178function TIPKControl.SaveToFile(s: String): Boolean;
1179begin
1180 Result := true;
1181 try
1182 Text.SaveTofile(s);
1183 FBasePath := ExtractFilePath(s);
1184 fname := s;
1185 except
1186 Result := false;
1187 end;
1188end;
1189
1190function TIPKControl.LoadFromFile(s: String): Boolean;
1191begin
1192 Result := true;
1193 if FileExists(s) then
1194 begin
1195 Text.LoadFromFile(s);
1196 if (Text[0] <> 'IPK-Standard-Version: 1.1')
1197 and(Text[0] <> 'IPK-Standard-Version: 1.0') then
1198 begin
1199 Result := false;
1200 exit;
1201 end;
1202 FBasePath := ExtractFilePath(s);
1203 fname := s;
1204 end
1205 else
1206 Result := false;
1207
1208 UseMoTranslation := true;
1209end;
1210
1211procedure TIPKControl.GetInternalFilesSection(lst: TStrings);
1212var
1213 j: Integer;
1214begin
1215 //Search for container-IPK files section
1216 j := SearchKeyIndex('Files', false);
1217 if j > -1 then
1218 begin
1219 ReadField('Files', lst);
1220 end;
1221end;
1222
1223end.
src/ipkdef.pas
(0 / 1223)
  
1{ Copyright (C) 2008-2010 Matthias Klumpp
2
3 Authors:
4 Matthias Klumpp
5
6 This unit is free software: you can redistribute it and/or modify it under
7 the terms of the GNU General Public License as published by the Free Software
8 Foundation, version 3.
9
10 This unit is distributed in the hope that it will be useful, but WITHOUT
11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License v3
15 along with this unit. If not, see <http://www.gnu.org/licenses/>.}
16//** Contains classes to process IPK files
17unit ipkdef;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24 Classes, GetText, liTypes, liUtils, SysUtils, FileUtil;
25
26type
27
28 //** Basic IPK reader class
29 TIPKBasic = class
30 private
31 function GetValue(s: String): String;
32 function SearchKeyIndex(s: String; localized: Boolean = true): Integer;
33 function SolveInclude(s: String): String;
34 function translate(s: String): String;
35 procedure WriteEntry(k, s: String);
36
37 procedure WriteType(atype: TPkgType);
38 function ReadType: TPkgType;
39 procedure WriteName(s: String);
40 function ReadName: String;
41 procedure WriteVersion(s: String);
42 function ReadVersion: String;
43 procedure WriteIcon(s: String);
44 function ReadIcon: String;
45 procedure WriteSDesc(s: String);
46 function ReadSDesc: String;
47 procedure WriteCategory(g: AppCategory);
48 function ReadCategory: AppCategory;
49 procedure WriteAuthor(s: String);
50 function ReadAuthor: String;
51 procedure WriteMaintainer(s: String);
52 function ReadMaintainer: String;
53 procedure WriteDisallows(s: String);
54 function ReadDisallows: String;
55 procedure WriteAppCMD(s: String);
56 function ReadAppCMD: String;
57 procedure WriteArchs(s: String);
58 function ReadArchs: String;
59 procedure WritePkgName(s: String);
60 function ReadPkgName: String;
61 procedure WriteIPKName(s: String);
62 function ReadIPKName: String;
63 procedure WriteDSupport(s: String);
64 function ReadDSupport: String;
65 procedure WriteWizImage(s: String);
66 function ReadWizImage: String;
67 procedure WriteBinary(s: String);
68 function ReadBinary: String;
69 procedure WriteUSource(s: String);
70 function ReadUSource: String;
71 procedure WriteDesktopFiles(s: String);
72 function ReadDesktopFiles: String;
73 procedure WriteInTerminal(b: Boolean);
74 function ReadInTerminal: Boolean;
75 protected
76 text: TStringList;
77 FBasePath: String;
78 clang: String;
79 motrans: Boolean;
80 mofile: String;
81 procedure WriteField(Name: String; info: TStrings);
82 procedure ReadField(Name: String; info: TStrings);
83 public
84 constructor Create;
85 destructor Destroy; override;
86
87 property BasePath: String read FBasePath write FBasePath;
88 property SType: TPkgType read ReadType write WriteType;
89 property AppName: String read ReadName write WriteName;
90 property AppVersion: String read ReadVersion write WriteVersion;
91 procedure ReadAppLicense(info: TStringList);
92 procedure WriteAppLicense(path: String);
93 procedure WriteAppLicense(info: TStringList);
94 procedure ReadAppDescription(info: TStringList);
95 procedure WriteAppDescription(path: String);
96 procedure WriteAppDescription(info: TStringList);
97 property Icon: String read ReadIcon write WriteIcon;
98 property LangCode: String read clang write clang;
99 property SDesc: String read ReadSDesc write WriteSDesc;
100 property Category: AppCategory read ReadCategory write WriteCategory;
101 property Author: String read ReadAuthor write WriteAuthor;
102 property Maintainer: String read ReadMaintainer write WriteMaintainer;
103 property Disallows: String read ReadDisallows write WriteDisallows;
104 procedure ReadProfiles(lst: TStrings);
105 procedure WriteProfiles(lst: TStrings);
106 procedure ReadBuildCMDs(lst: TStrings);
107 procedure WriteBuildCMDs(lst: TStrings);
108 property AppCMD: String read ReadAppCMD write WriteAppCMD;
109 property Architecture: String read ReadArchs write WriteArchs;
110 property PkName: String read ReadPkgName write WritePkgName;
111 property IPKName: String read ReadIPKName write WriteIPKName;
112 property DSupport: String read ReadDSupport write WriteDSupport;
113 property WizImage: String read ReadWizImage write WriteWizImage;
114 property Binary: String read ReadBinary write WriteBinary;
115 property USource: String read ReadUSource write WriteUSource;
116 property Desktopfiles: String read ReadDesktopFiles write WriteDesktopFiles;
117 property InTerminal: Boolean read ReadInTerminal write WriteInTerminal;
118 procedure ReadDependencies(dname: String; info: TStringList);
119 procedure WriteDependencies(dname: String; path: String);
120 procedure WriteDependencies(dname: String; info: TStringList);
121 function LoadFromFile(s: String): Boolean; virtual; abstract;
122 property UseMoTranslation: Boolean read motrans write motrans;
123 procedure GetMoFileList(list: TStringList);
124 procedure SetMoFilesToDir(dir: String);
125 end;
126
127 TIPKControl = class;
128
129 //** Class to handle IPK scripts
130 TIPKScript = class(TIPKBasic)
131 private
132 fname: String;
133 public
134 constructor Create;
135 destructor Destroy; override;
136
137 function SaveToFile(s: String): Boolean;
138 function LoadFromFile(s: String): Boolean; override;
139 function LoadFromList(lst: TStrings): Boolean;
140 procedure GetFiles(id: Integer; lst: TStrings);
141 procedure GetDirectFileList(id: Integer; lst: TStrings);
142 function FinalizeToControl: TIPKControl;
143 end;
144
145 //** Class to read IPK control files
146 TIPKControl = class(TIPKBasic)
147 private
148 fname: String;
149 public
150 constructor Create;
151 constructor Create(path: String);
152 destructor Destroy; override;
153
154 function SaveToFile(s: String): Boolean;
155 procedure GetInternalFilesSection(lst: TStrings);
156 function LoadFromFile(s: String): Boolean; override;
157
158 property RawText: TStringList read text write text;
159 end;
160
161implementation
162
163{ TIPKBasic }
164
165constructor TIPKBasic.Create;
166begin
167 inherited;
168 Text := TStringList.Create;
169 FBasePath := ExtractFilePath(ParamStr(0));
170 clang := '';
171 mofile := '';
172 motrans := false;
173end;
174
175destructor TIPKBasic.Destroy;
176begin
177 Text.Free;
178 inherited;
179end;
180
181procedure TIPKBasic.WriteEntry(k, s: String);
182begin
183 s := k + ': ' + s;
184 if SearchKeyIndex(k) > -1 then
185 Text[SearchKeyIndex(k)] := s
186 else
187 Text.Add(s);
188end;
189
190function TIPKBasic.GetValue(s: String): String;
191begin
192 if pos(':', s) = length(s) then
193 begin
194 //There is an empty block (without value)
195 Result := '';
196 exit;
197 end;
198 Result := copy(s, pos(':', s) + 1, length(s));
199 if (Result[1] = ' ') then
200 Result := copy(Result, 2, length(Result));
201end;
202
203function TIPKBasic.SearchKeyIndex(S: String; localized: Boolean = true): Integer;
204var
205 i: Integer;
206 h: String;
207begin
208 Result := -1;
209 i := Text.Count;
210 //First search for localized entry
211 if (clang <> '') and (localized) then
212 begin
213 for i := 0 to Text.Count - 1 do
214 begin
215 if (length(Text[i])>0)and(Text[i][1]<>'#')and(Text[i][1]<>' ') then
216 begin
217 h := copy(Text[i], 0, pos(':', Text[i]) - 1);
218 if LowerCase(h) = LowerCase(s) + '[' + clang + ']' then
219 begin
220 Result := i;
221 break;
222 end;
223 end;
224 end;
225 end;
226 //Then search the general key
227 if (not localized) or (Result < 0) then
228 for i := 0 to Text.Count - 1 do
229 begin
230 if (length(Text[i])>0)and(Text[i][1]<>'#')and(Text[i][1]<>' ') then
231 begin
232 h := copy(Text[i], 0, pos(':', Text[i]) - 1);
233 if LowerCase(h) = LowerCase(s) then
234 begin
235 Result := i;
236 break;
237 end;
238 end;
239 end;
240end;
241
242function TIPKBasic.SolveInclude(s: String): String;
243var
244 h: String;
245begin
246 h := copy(s, pos('"', s) + 1, length(s));
247 h := copy(h, 0, pos('"', h) - 1);
248 if not FilenameIsAbsolute(h) then
249 Result := AppendPathDelim(FBasePath) + h
250 else
251 Result := h;
252end;
253
254function TIPKBasic.Translate(s: String): String;
255var
256 i: Integer;
257 mo: TMoFile;
258begin
259 Result := s;
260 if mofile = '~' then
261 exit;
262 if mofile = '' then
263 begin
264 mofile := '~';
265 for i := 0 to text.Count - 1 do
266 if pos('include:', Text[i]) > 0 then
267 if LowerCase(ExtractFileExt(SolveInclude(Text[i]))) = '.mo' then
268 begin
269 mofile := ExtractFileName(SolveInclude(Text[i]));
270 if (mofile = GetLangId + '.mo') or
271 (copy(mofile, pos('-', mofile) + 1, length(mofile)) = GetlangId + '.mo') then
272 break
273 else
274 mofile := '~';
275 end;
276 end;
277 if (mofile = '~') or (trim(mofile) = '') or (not FileExists(FBasePath+mofile)) then
278 exit;
279 mo := TMoFile.Create(FBasePath+mofile);
280 Result := mo.Translate(s);
281 mo.Free;
282end;
283
284procedure TIPKBasic.GetMoFileList(list: TStringList);
285var
286 i: Integer;
287begin
288 for i := 0 to Text.Count - 1 do
289 if pos('include:', Text[i]) > 0 then
290 begin
291 if (ExtractFileExt(SolveInclude(text[i]))) = '.mo' then
292 list.Add(SolveInclude(text[i]));
293 end;
294end;
295
296procedure TIPKBasic.SetMoFilesToDir(dir: String);
297var
298 list: TStringList;
299 i: Integer;
300begin
301 list := TStringList.Create;
302 GetMoFileList(list);
303 i := 0;
304 while i < text.Count do
305 begin
306 if (pos('include:', text[i])>0) and(pos('.mo', text[i])>0) then
307 begin
308 text.Delete(i);
309 end
310 else
311 Inc(i);
312 end;
313 text.Insert(1, '');
314 for i := 0 to list.Count-1 do
315 text.Insert(1, 'include:"'+dir+'/'+ExtractFileName(list[i])+'"');
316 list.Free;
317end;
318
319procedure TIPKBasic.WriteField(Name: String; info: TStrings);
320var
321 i: Integer;
322begin
323 if info.Count >= 0 then
324 begin
325 i := SearchKeyIndex(Name);
326 if i > 0 then
327 begin
328
329 Text.Delete(i);
330 while (i < Text.Count) and (Text[i] <> '') and (Text[i][1] = ' ') do
331 Text.Delete(i);
332 end;
333
334 Text.Add(Name + ': ' + info[0]);
335 for i := 1 to info.Count - 1 do
336 Text.Add(' ' + info[i]);
337 end;
338end;
339
340procedure TIPKBasic.ReadField(Name: String; info: TStrings);
341var
342 i: Integer;
343 s: String;
344begin
345 i := SearchKeyIndex(Name);
346 s := '';
347 if i > -1 then
348 s := Text[i];
349 info.Clear;
350 if s = '' then
351 exit;
352 if pos('include:"', s) > 0 then
353 info.LoadFromFile(SolveInclude(s))
354 else
355 begin
356 info.Add(GetValue(Text[i]));
357 Inc(i);
358 if i < Text.Count then
359 repeat
360 s := Text[i];
361 if s[1] = ' ' then
362 begin
363 s := copy(s, 2, length(s));
364 info.Add(s);
365 end;
366 Inc(i);
367 until (i >= Text.Count) or (Text[i][1] <> ' ') or (length(Text[i]) < 1);
368 end;
369end;
370
371procedure TIPKBasic.WriteType(atype: TPkgType);
372var
373 h: String;
374begin
375 case AType of
376 ptLinstall: h := 'Type: linstall';
377 ptDLink: h := 'Type: dlink';
378 ptContainer: h := 'Type: container';
379 end;
380 if SearchKeyIndex('Type', false) > -1 then
381 Text[SearchKeyIndex('Type', false)] := h
382 else
383 Text.Add(h);
384end;
385
386function TIPKBasic.ReadType: TPkgType;
387var
388 s: String;
389 j: Integer;
390begin
391 Result := ptUnknown;
392 j := SearchKeyIndex('Type', false);
393
394 if j > -1 then
395 begin
396 s := Text[j];
397 writeLn(s);
398 if GetValue(s) = 'linstall' then
399 Result := ptLinstall;
400 if GetValue(s) = 'dlink' then
401 Result := ptDLink;
402 if GetValue(s) = 'container' then
403 Result := ptContainer;
404 end;
405end;
406
407procedure TIPKBasic.WriteName(s: String);
408var
409 k: String;
410begin
411 if clang = '' then
412 k := 'Name'
413 else
414 k := 'Name[' + clang + ']';
415
416 WriteEntry(k, s);
417end;
418
419function TIPKBasic.ReadName: String;
420var
421 j: Integer;
422begin
423 Result := '';
424 j := SearchKeyIndex('Name');
425 if j > -1 then
426 Result := GetValue(Text[j]);
427 Result := translate(Result);
428end;
429
430procedure TIPKBasic.WriteVersion(s: String);
431var
432 k: String;
433begin
434 if clang = '' then
435 k := 'Version'
436 else
437 k := 'Version[' + clang + ']';
438
439 WriteEntry(k, s);
440end;
441
442function TIPKBasic.ReadVersion: String;
443var
444 j: Integer;
445begin
446 Result := '';
447 j := SearchKeyIndex('Version');
448 if j > -1 then
449 Result := GetValue(Text[j]);
450end;
451
452procedure TIPKBasic.ReadAppLicense(info: TStringList);
453begin
454 ReadField('License', info);
455end;
456
457procedure TIPKBasic.WriteAppLicense(path: String);
458var
459 s: String;
460 i: Integer;
461begin
462 s := 'License: include:"' + path + '"';
463
464 i := SearchKeyIndex('License');
465 if i > 0 then
466 begin
467 Text.Delete(i);
468 while (i < Text.Count) and (Text[i][1] = ' ') do
469 Text.Delete(i);
470 end;
471
472 if i > -1 then
473 Text[i] := s
474 else
475 Text.Add(s);
476end;
477
478procedure TIPKBasic.WriteAppLicense(info: TStringList);
479begin
480 WriteField('License', info);
481end;
482
483procedure TIPKBasic.ReadAppDescription(info: TStringList);
484begin
485 ReadField('Description', info);
486end;
487
488procedure TIPKBasic.WriteAppDescription(path: String);
489var
490 s: String;
491 i: Integer;
492begin
493 s := 'Description: include:"' + path + '"';
494
495 i := SearchKeyIndex('Description');
496 if i > 0 then
497 begin
498 Text.Delete(i);
499 while (i < Text.Count) and (Text[i][1] = ' ') do
500 Text.Delete(i);
501 end;
502
503 if i > -1 then
504 Text[i] := s
505 else
506 Text.Add(s);
507end;
508
509procedure TIPKBasic.WriteAppDescription(info: TStringList);
510begin
511 WriteField('Description', info);
512end;
513
514procedure TIPKBasic.WriteIcon(s: String);
515begin
516 WriteEntry('Icon', s);
517end;
518
519function TIPKBasic.ReadIcon: String;
520var
521 j: Integer;
522begin
523 Result := '';
524 j := SearchKeyIndex('Icon', false);
525 if j > -1 then
526 Result := GetValue(Text[j]);
527end;
528
529procedure TIPKBasic.WriteSDesc(s: String);
530var
531 k: String;
532begin
533 if clang = '' then
534 k := 'SDesc'
535 else
536 k := 'SDesc[' + clang + ']';
537
538 WriteEntry(k, s);
539end;
540
541function TIPKBasic.ReadSDesc: String;
542var
543 j: Integer;
544begin
545 Result := '';
546 j := SearchKeyIndex('SDesc');
547 if j > -1 then
548 Result := GetValue(Text[j]);
549
550 Result := translate(Result);
551end;
552
553procedure TIPKBasic.WriteCategory(g: AppCategory);
554var
555 s: String;
556begin
557 case g of
558 gtALL: s := 'All';
559 gtEDUCATION: s := 'Education';
560 gtOFFICE: s := 'Office';
561 gtDEVELOPMENT: s := 'Development';
562 gtGRAPHIC: s := 'Graphic';
563 gtNETWORK: s := 'Network';
564 gtGAMES: s := 'Games';
565 gtSYSTEM: s := 'System';
566 gtMULTIMEDIA: s := 'Multimedia';
567 gtADDITIONAL: s := 'Additional';
568 gtOTHER: s := 'Other';
569 end;
570 s := 'Group: ' + s;
571
572 if SearchKeyIndex('Group', false) > -1 then
573 Text[SearchKeyIndex('Group', false)] := s
574 else
575 Text.Add(s);
576end;
577
578function TIPKBasic.ReadCategory: AppCategory;
579var
580 j: Integer;
581 s: String;
582begin
583 Result := gtUNKNOWN;
584 j := SearchKeyIndex('Group', false);
585 if j > -1 then
586 s := GetValue(Text[j]);
587
588 s := LowerCase(s);
589 if s = 'all' then
590 Result := gtALL;
591 if s = 'education' then
592 Result := gtEDUCATION;
593 if s = 'office' then
594 Result := gtOFFICE;
595 if s = 'development' then
596 Result := gtDEVELOPMENT;
597 if s = 'graphic' then
598 Result := gtGRAPHIC;
599 if s = 'network' then
600 Result := gtNETWORK;
601 if s = 'games' then
602 Result := gtGAMES;
603 if s = 'system' then
604 Result := gtSYSTEM;
605 if s = 'multimedia' then
606 Result := gtMULTIMEDIA;
607 if s = 'additional' then
608 Result := gtADDITIONAL;
609 if s = 'other' then
610 Result := gtOTHER;
611end;
612
613procedure TIPKBasic.ReadBuildCMDs(lst: TStrings);
614begin
615 ReadField('Build', lst);
616end;
617
618procedure TIPKBasic.WriteBuildCMDs(lst: TStrings);
619begin
620 WriteField('Build', lst);
621end;
622
623procedure TIPKBasic.WriteAuthor(s: String);
624var
625 k: String;
626begin
627 if clang = '' then
628 k := 'Author'
629 else
630 k := 'Author[' + clang + ']';
631
632 WriteEntry(k, s);
633end;
634
635function TIPKBasic.ReadAuthor: String;
636var
637 j: Integer;
638begin
639 Result := '';
640 j := SearchKeyIndex('Author');
641 if j > -1 then
642 Result := GetValue(Text[j]);
643 Result := translate(Result);
644end;
645
646procedure TIPKBasic.WriteMaintainer(s: String);
647var
648 k: String;
649begin
650 if clang = '' then
651 k := 'Maintainer'
652 else
653 k := 'Maintainer[' + clang + ']';
654
655 WriteEntry(k, s);
656end;
657
658function TIPKBasic.ReadMaintainer: String;
659var
660 j: Integer;
661begin
662 Result := '';
663 j := SearchKeyIndex('Maintainer');
664 if j > -1 then
665 Result := GetValue(Text[j]);
666 Result := translate(Result);
667end;
668
669procedure TIPKBasic.WriteDisallows(s: String);
670var
671 k: String;
672begin
673 k := 'Disallow';
674 WriteEntry(k, s);
675end;
676
677function TIPKBasic.ReadDisallows: String;
678var
679 j: Integer;
680begin
681 Result := '';
682 j := SearchKeyIndex('Disallow', false);
683 if j > -1 then
684 Result := GetValue(Text[j]);
685end;
686
687procedure TIPKBasic.WriteProfiles(lst: TStrings);
688var
689 k, s: String;
690 i: Integer;
691begin
692 k := 'Profile[';
693 for i := 0 to lst.Count - 1 do
694 begin
695 s := k + IntToStr(i) + ']: ' + lst[i];
696 if SearchKeyIndex(k) > -1 then
697 Text[SearchKeyIndex(k)] := s
698 else
699 Text.Add(s);
700 end;
701end;
702
703procedure TIPKBasic.ReadProfiles(lst: TStrings);
704var
705 j: Integer;
706
707 function GetProfileName(id: Integer): String;
708 var
709 i: Integer;
710 begin
711 Result := '';
712 i := SearchKeyIndex('Profiles[' + IntToStr(id) + ']');
713 if (id = 0) and (i < 0) then
714 i := SearchKeyIndex('Profiles');
715 if i > -1 then
716 Result := GetValue(Text[i]);
717 end;
718
719begin
720 j := 0;
721 repeat
722 lst.Add(GetProfileName(j));
723 Inc(j);
724 until GetProfileName(j) = '';
725end;
726
727procedure TIPKBasic.WriteAppCMD(s: String);
728var
729 k: String;
730begin
731 k := 'AppCMD';
732
733 WriteEntry(k, s);
734end;
735
736function TIPKBasic.ReadAppCMD: String;
737var
738 j: Integer;
739begin
740 Result := '';
741 j := SearchKeyIndex('AppCMD', false);
742 if j > -1 then
743 Result := GetValue(Text[j]);
744end;
745
746procedure TIPKBasic.WriteArchs(s: String);
747var
748 k: String;
749begin
750 k := 'Architecture';
751 WriteEntry(k, s);
752end;
753
754function TIPKBasic.ReadArchs: String;
755var
756 j: Integer;
757begin
758 Result := '';
759 j := SearchKeyIndex('Architecture', false);
760 if j > -1 then
761 Result := GetValue(Text[j]);
762end;
763
764procedure TIPKBasic.WritePkgName(s: String);
765var
766 k: String;
767begin
768 k := 'PkName';
769 WriteEntry(k, s);
770end;
771
772function TIPKBasic.ReadPkgName: String;
773var
774 j: Integer;
775begin
776 Result := '';
777 j := SearchKeyIndex('PkName', false);
778 if j > -1 then
779 Result := GetValue(Text[j]);
780end;
781
782procedure TIPKBasic.WriteIPKName(s: String);
783var
784 k: String;
785begin
786 k := 'IPKName';
787 WriteEntry(k, s);
788end;
789
790function TIPKBasic.ReadIPKName: String;
791var
792 j: Integer;
793begin
794 Result := '';
795 j := SearchKeyIndex('IPKName', false);
796 if j > -1 then
797 Result := GetValue(Text[j]);
798end;
799
800procedure TIPKBasic.WriteDSupport(s: String);
801var
802 k: String;
803begin
804 k := 'DSupport';
805 WriteEntry(k, s);
806end;
807
808function TIPKBasic.ReadDSupport: String;
809var
810 j: Integer;
811begin
812 Result := '';
813 j := SearchKeyIndex('DSupport', false);
814 if j > -1 then
815 Result := GetValue(Text[j]);
816end;
817
818procedure TIPKBasic.ReadDependencies(dname: String; info: TStringList);
819var
820 i: Integer;
821 s: String;
822begin
823 if (dname = 'all') or (dname = '') then
824 i := SearchKeyIndex('Dependencies', false)
825 else
826 i := SearchKeyIndex('Dependencies[' + dname + ']', false);
827
828 s := '';
829 if i > -1 then
830 s := Text[i];
831 info.Clear;
832
833 if s = '' then
834 exit;
835 if pos('include:"', s) > 0 then
836 info.LoadFromFile(SolveInclude(s))
837 else
838 begin
839 info.Add(GetValue(Text[i]));
840 Inc(i);
841 repeat
842 s := Text[i];
843 if length(s) > 0 then
844 if s[1] = ' ' then
845 begin
846 s := copy(s, 2, length(s));
847 info.Add(s);
848 end;
849 Inc(i);
850 until (length(Text[i]) = 0) or (i >= Text.Count) or (Text[i][1] <> ' ');
851 end;
852end;
853
854procedure TIPKBasic.WriteDependencies(dname: String; path: String);
855var
856 s: String;
857 i: Integer;
858begin
859 if (dname = 'all') or (dname = '') then
860 s := 'Dependencies: include:"' + path + '"'
861 else
862 s := 'Dependencies[' + dname + ']: include:"' + path + '"';
863
864 i := SearchKeyIndex('Dependencies');
865 if i > 0 then
866 begin
867 Text.Delete(i);
868 while (i < Text.Count) and (Text[i][1] = ' ') do
869 Text.Delete(i);
870 end;
871
872 if i > -1 then
873 Text[i] := s
874 else
875 Text.Add(s);
876end;
877
878procedure TIPKBasic.WriteDependencies(dname: String; info: TStringList);
879var
880 i: Integer;
881 s: String;
882begin
883 if info.Count >= 0 then
884 begin
885 if (dname = 'all') or (dname = '') then
886 begin
887 s := 'Dependencies';
888 i := SearchKeyIndex(s, false);
889 end
890 else
891 begin
892 s := 'Dependencies[' + dname + ']';
893 i := SearchKeyIndex(s, false);
894 end;
895
896 if i > 0 then
897 begin
898
899 Text.Delete(i);
900 while (i < Text.Count) and (Text[i] <> '') and (Text[i][1] = ' ') do
901 Text.Delete(i);
902 end;
903
904 Text.Add(s + ': ' + info[0]);
905 for i := 1 to info.Count - 1 do
906 Text.Add(' ' + info[i]);
907
908 end;
909end;
910
911procedure TIPKBasic.WriteWizImage(s: String);
912var
913 k: String;
914begin
915 k := 'WizImage';
916 WriteEntry(k, s);
917end;
918
919function TIPKBasic.ReadWizImage: String;
920var
921 j: Integer;
922begin
923 Result := '';
924 j := SearchKeyIndex('WizImage', false);
925 if j > -1 then
926 Result := GetValue(Text[j]);
927end;
928
929procedure TIPKBasic.WriteBinary(s: String);
930begin
931 WriteEntry('Binary', s);
932end;
933
934function TIPKBasic.ReadBinary: String;
935var
936 j: Integer;
937begin
938 Result := '';
939 j := SearchKeyIndex('Binary', false);
940 if j > -1 then
941 Result := GetValue(Text[j]);
942end;
943
944procedure TIPKBasic.WriteUSource(s: String);
945begin
946 WriteEntry('USource', s);
947end;
948
949function TIPKBasic.ReadUSource: String;
950var
951 j: Integer;
952begin
953 Result := '';
954 j := SearchKeyIndex('USource', false);
955 if j > -1 then
956 Result := GetValue(Text[j]);
957end;
958
959procedure TIPKBasic.WriteDesktopFiles(s: String);
960begin
961 WriteEntry('Desktopfiles', s);
962end;
963
964function TIPKBasic.ReadDesktopFiles: String;
965var
966 j: Integer;
967begin
968 Result := '';
969 j := SearchKeyIndex('Desktopfiles', false);
970 if j > -1 then
971 Result := GetValue(Text[j]);
972end;
973
974procedure TIPKBasic.WriteInTerminal(b: Boolean);
975begin
976 if b = true then
977 WriteEntry('Desktopfiles', 'true')
978 else
979 WriteEntry('Desktopfiles', 'false');
980end;
981
982function TIPKBasic.ReadInTerminal: Boolean;
983var
984 j: Integer;
985 s: String;
986begin
987 j := SearchKeyIndex('InTerminal', false);
988 if j > -1 then
989 s := GetValue(Text[j]);
990 if LowerCase(s) = 'true' then
991 Result := true
992 else
993 Result := false;
994end;
995
996{ TIPKScript }
997
998constructor TIPKScript.Create;
999begin
1000 inherited;
1001 Text.Add('IPK-Standard-Version: 1.1');
1002 Text.Add('');
1003 fname := '';
1004end;
1005
1006destructor TIPKScript.Destroy;
1007begin
1008 inherited;
1009end;
1010
1011function TIPKScript.SaveToFile(s: String): Boolean;
1012begin
1013 Result := true;
1014 try
1015 Text.SaveTofile(s);
1016 FBasePath := ExtractFilePath(s);
1017 fname := s;
1018 except
1019 Result := false;
1020 end;
1021end;
1022
1023function TIPKScript.LoadFromFile(s: String): Boolean;
1024begin
1025 Result := true;
1026 if FileExists(s) then
1027 begin
1028 Text.LoadFromFile(s);
1029 if (Text[0] <> 'IPK-Standard-Version: 1.1')
1030 and(Text[0] <> 'IPK-Standard-Version: 1.0') then
1031 begin
1032 Result := false;
1033 Text.Clear;
1034 Text.Add('IPK-Standard-Version: 1.1');
1035 Text.Add('');
1036 exit;
1037 end;
1038 FBasePath := ExtractFilePath(s);
1039 fname := s;
1040 end
1041 else
1042 Result := false;
1043end;
1044
1045function TIPKScript.LoadFromList(lst: TStrings): Boolean;
1046begin
1047 Result := true;
1048 writeLn(lst[0]);
1049 if (lst[0] <> 'IPK-Standard-Version: 1.1')
1050 and(lst[0] <> 'IPK-Standard-Version: 1.0') then
1051 begin
1052 Result := false;
1053 exit;
1054 end
1055 else
1056 Text.Assign(lst);
1057end;
1058
1059function TIPKScript.FinalizeToControl: TIPKControl;
1060var
1061 i: Integer;
1062 cont: TIPKControl;
1063
1064 procedure ProcessLine(ln: String);
1065 begin
1066 if length(ln) > 0 then
1067 begin
1068 if ln[1] = '#' then
1069 exit;
1070 end;
1071
1072 if pos('#', ln) > 0 then
1073 ln := copy(ln, pos('#', ln) + 1, length(ln));
1074
1075 if pos('IPKName:', ln) > 0 then
1076 exit;
1077
1078 cont.RawText.Add(ln);
1079 end;
1080
1081begin
1082 cont := TIPKControl.Create;
1083
1084 for i := 0 to Text.Count - 1 do
1085 if pos('!-Files', Text[i]) <= 0 then
1086 ProcessLine(Text[i]);
1087
1088 Result := cont;
1089end;
1090
1091procedure TIPKScript.GetDirectFileList(id: Integer; lst: TStrings);
1092var
1093 i, j: Integer;
1094 s: String;
1095 fsec: TStringList;
1096begin
1097 fsec := TStringList.Create;
1098 for j := 0 to Text.Count - 1 do
1099 if pos('!-Files ~' + IntToStr(id), Text[j]) > 0 then
1100 break;
1101
1102 for i := j + 1 to Text.Count - 1 do
1103 if pos('!-Files ~', Text[i]) > 0 then
1104 break
1105 else
1106 fsec.Add(Text[i]);
1107
1108 i := 0;
1109 while i < fsec.Count - 1 do
1110 begin
1111
1112 if fsec[i][1] = '>' then
1113 s := copy(fsec[i], 2, length(fsec[i]))
1114 else
1115 begin
1116 if (fsec[i][1] = '/') or (fsec[i][1] = '.') then
1117 begin
1118 lst.Add(s);
1119 if fsec[i][1] = '.' then
1120 lst.Add(FBasePath + fsec[i])
1121 else
1122 lst.Add(fsec[i]);
1123 end;
1124 end;
1125 Inc(i);
1126 end;
1127end;
1128
1129procedure TIPKScript.GetFiles(id: Integer; lst: TStrings);
1130var
1131 i, j: Integer;
1132begin
1133 //Search for container-IPK files section
1134 j := SearchKeyIndex('Files');
1135 if j > -1 then
1136 begin
1137 ReadField('Files', lst);
1138 end
1139 else
1140 begin
1141 //Read normal files section
1142 for j := 0 to Text.Count - 1 do
1143 if pos('!-Files ~' + IntToStr(id), Text[j]) > 0 then
1144 break;
1145
1146 for i := j + 1 to Text.Count - 1 do
1147 if pos('!-Files ~', Text[i]) > 0 then
1148 break
1149 else
1150 lst.Add(Text[i]);
1151 end;
1152end;
1153
1154{ TIPKControl }
1155
1156constructor TIPKControl.Create(path: String);
1157begin
1158 inherited Create;
1159
1160 LoadFromFile(path);
1161 FBasePath := ExtractFilePath(path);
1162
1163 fname := path;
1164end;
1165
1166constructor TIPKControl.Create;
1167begin
1168 inherited Create;
1169 fname := '';
1170 FBasePath := '';
1171end;
1172
1173destructor TIPKControl.Destroy;
1174begin
1175 inherited;
1176end;
1177
1178function TIPKControl.SaveToFile(s: String): Boolean;
1179begin
1180 Result := true;
1181 try
1182 Text.SaveTofile(s);
1183 FBasePath := ExtractFilePath(s);
1184 fname := s;
1185 except
1186 Result := false;
1187 end;
1188end;
1189
1190function TIPKControl.LoadFromFile(s: String): Boolean;
1191begin
1192 Result := true;
1193 if FileExists(s) then
1194 begin
1195 Text.LoadFromFile(s);
1196 if (Text[0] <> 'IPK-Standard-Version: 1.1')
1197 and(Text[0] <> 'IPK-Standard-Version: 1.0') then
1198 begin
1199 Result := false;
1200 exit;
1201 end;
1202 FBasePath := ExtractFilePath(s);
1203 fname := s;
1204 end
1205 else
1206 Result := false;
1207
1208 UseMoTranslation := true;
1209end;
1210
1211procedure TIPKControl.GetInternalFilesSection(lst: TStrings);
1212var
1213 j: Integer;
1214begin
1215 //Search for container-IPK files section
1216 j := SearchKeyIndex('Files', false);
1217 if j > -1 then
1218 begin
1219 ReadField('Files', lst);
1220 end;
1221end;
1222
1223end.
  
1{ Copyright (C) 2010 Matthias Klumpp
2
3 Authors:
4 Matthias Klumpp
5
6 This program is free software: you can redistribute it and/or modify it under
7 the terms of the GNU General Public License as published by the Free Software
8 Foundation, version 3.
9
10 This program is distributed in the hope that it will be useful, but WITHOUT
11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License v3
15 along with this program. If not, see <http://www.gnu.org/licenses/>.}
16//** Contains class to package signed and unsigned IPK package source files
17unit ipkpackage;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24 Classes, FileUtil, gpgsign, liUtils, liTypes, SysUtils, TarArchive;
25
26type
27 //** Creates IPK packages from preprocessed source files
28
29 { TLiPackager }
30
31 TLiPackager = class
32 private
33 OutFileName: String;
34 pkrandom: String;
35 basename: String;
36 mntar: TTarArchive;
37 finalized: Boolean;
38 bdir: String;
39 maxbytes: Int64;
40
41 function RandomID: String;
42 public
43 constructor Create(aIPKFile: String);
44 destructor Destroy; override;
45
46 //** Add a new file to the IPK structure @return False if already finalized or other error
47 function AddFile(fname: String): Boolean;
48 //** Finalize the base file for signing
49 procedure Finalize;
50 //** Sign the package
51 function SignPackage: Boolean;
52 //** Compress package and copy it to output @returns Success of operation
53 function ProduceIPKPackage: Boolean;
54 //** Base directory (root of package)
55 property BaseDir: String read bdir write bdir;
56 //** Set IPK file name
57 property IPKFile: String read OutFileName write OutFileName;
58 end;
59
60 //** Unpacks IPK package structure
61
62 { TLiUnpacker }
63
64 TLiUnpacker = class
65 private
66 ipkfile: String;
67 workdir: String;
68 signChecked: Boolean;
69 public
70 constructor Create(aIPKFile: String);
71 destructor Destroy; override;
72
73 //** Prepare IPK tar file for extracting
74 procedure Prepare;
75 //** Verify signature (if there is any)
76 function CheckSignature: TPkgSigState;
77 //** Unpack file @returns Success of operation
78 function UnpackFile(fname: String): Boolean;
79 //** Unpacker's working dir
80 property WDir: String read workdir;
81 end;
82
83 //** Create small LZMA compressed files for update sources
84 TLiUpdateBit = class
85 private
86 xz: TTarArchive;
87 public
88 constructor Create;
89 destructor Destroy; override;
90
91 //** Compress files to XZ
92 procedure Compress(infile: String; outfile: String);
93 //** Decompress a file
94 procedure Decompress(infile: String; outfile: String);
95 end;
96
97implementation
98
99{ TLiPackager }
100
101constructor TLiPackager.Create(aIPKFile: String);
102begin
103 inherited Create;
104 randomize;
105 pkrandom := '-' + RandomID + RandomID + RandomID;
106 finalized := false;
107 OutFileName := aIPKFile;
108 basename := tmpdir + ExtractFileName(OutFileName) + pkrandom + '.tar';
109 mntar := TTarArchive.Create;
110 mntar.Compression:=cmXZ; //IPK packages are XZ compressed
111 mntar.TarArchive := basename;
112end;
113
114destructor TLiPackager.Destroy;
115begin
116 if not finalized then
117 mntar.Free;
118 inherited;
119end;
120
121function TLiPackager.RandomID: String;
122begin
123 Result := IntToStr(random(99));
124end;
125
126function TLiPackager.AddFile(fname: String): Boolean;
127begin
128 if finalized then
129 Result := false
130 else
131 begin
132 mntar.BaseDir := bdir;
133 if mntar.AddFile(fname) = 0 then
134 Result := true
135 else
136 Result := false;
137 end;
138end;
139
140procedure TLiPackager.Finalize;
141begin
142 p_info('Finalizing package.');
143 if mntar.Finalize > 0 then
144 raise Exception.Create('Error while building package.');
145 mntar.Free;
146 finalized := true;
147end;
148
149function TLiPackager.SignPackage: Boolean;
150var
151 sign: TGPGSignWrapper;
152 oldbase: String;
153 rs: Integer;
154begin
155 Result := false;
156 if (not Finalized) then
157 raise Exception.Create('IPK file was not finalized before signing.');
158
159 oldbase := basename;
160 sign := TGPGSignWrapper.Create;
161 sign.FileName := oldbase;
162 Result := true;
163 if FileExistsUTF8(ExtractFilePath(oldbase) + '/signature.asc') then
164 DeleteFile(ExtractFilePath(oldbase) + '/signature.asc');
165
166 if not sign.Signfile(ExtractFilePath(oldbase) + '/signature.asc') then
167 begin
168 Result := false;
169 sign.Free;
170 exit;
171 end;
172 sign.Free;
173
174 pkrandom := '-' + RandomID + RandomID + RandomID;
175 basename := tmpdir + ExtractFileName(OutFileName) + pkrandom + '.tar';
176 mntar := TTarArchive.Create;
177 mntar.Compression:=cmNone; //No compression here
178 mntar.TarArchive := basename;
179
180 mntar.BaseDir := ExtractFilePath(oldbase);
181
182 RenameFile(oldbase, ExtractFilePath(oldbase) + '/content.tar');
183 oldbase := ExtractFilePath(oldbase) + '/content.tar';
184
185 rs := mntar.AddFile(oldbase);
186 if rs = 0 then
187 begin
188 rs := mntar.AddFile(ExtractFilePath(oldbase) + 'signature.asc');
189 if rs <> 0 then
190 raise Exception.Create('Error while combining signed package.');
191 end
192 else
193 raise Exception.Create('Error while combining signed package.');
194 mntar.Finalize;
195 mntar.Free;
196
197 DeleteFile(ExtractFilePath(oldbase) + 'signature.asc');
198 DeleteFile(oldbase);
199end;
200
201function TLiPackager.ProduceIPKPackage: Boolean;
202begin
203 Result := true;
204 if FileExists(OutFileName) then
205 Exception.Create('Output file already exists!');
206 if (not Finalized) then
207 raise Exception.Create('IPK file was not finalized.');
208
209 if not finalized then mntar.Finalize;
210
211 FileCopy(basename,outfilename);
212 DeleteFile(basename);
213end;
214
215{ TLiUnpacker }
216
217constructor TLiUnpacker.Create(aIPKFile: String);
218begin
219 inherited Create;
220 ipkfile := aIPKFile;
221 workdir := tmpdir + ExtractFileName(ipkfile) + '/';
222 SysUtils.ForceDirectories(workdir);
223 signChecked := false;
224end;
225
226destructor TLiUnpacker.Destroy;
227begin
228 inherited;
229end;
230
231procedure TLiUnpacker.Prepare;
232begin
233 if not FileExists(ipkfile) then
234 Exception.Create('IPK file does not exists!');
235
236 FileCopy(ipkfile, workdir+'ipktar.tar');
237 //Some more praparation later...
238end;
239
240function TLiUnpacker.CheckSignature: TPkgSigState;
241var
242 mnarc: TTarArchive;
243 hasSignature: Boolean;
244 sign: TGPGSignWrapper;
245 res: Integer;
246begin
247 hasSignature := false;
248 mnarc := TTarArchive.Create;
249 mnarc.TarArchive := workdir + 'ipktar.tar';
250 mnarc.Compression:=cmNone; //If we have a signature, covering tar is not compressed
251 mnarc.BaseDir := workdir;
252
253 Result := psNone;
254 //Check if package has signature
255 hasSignature := mnarc.FileInArchive('signature.asc');
256
257 if hasSignature then
258 begin
259 res := mnarc.ExtractFile('signature.asc');
260 res += mnarc.ExtractFile('content.tar');
261
262 if res <> 0 then
263 begin
264 //!!! This should be done better!
265 raise Exception.Create('Could not verify signature!');
266 end;
267
268 DeleteFile(workdir + 'ipktar.tar');
269 RenameFile(workdir + 'content.tar', workdir + 'ipktar.tar');
270 Result := psUntrusted;
271 //Now check signature
272 sign := TGPGSignWrapper.Create;
273 sign.FileName := workdir + 'ipktar.tar';
274 if sign.Verify(workdir + 'signature.asc') then
275 Result := psTrusted;
276 sign.Free;
277 end;
278 mnarc.Free;
279 signChecked := true;
280end;
281
282function TLiUnpacker.UnpackFile(fname: String): Boolean;
283var
284 arc: TTarArchive;
285begin
286 if not signChecked then
287 CheckSignature;
288 Result := false;
289 if length(fname) < 2 then
290 exit;
291
292 fname := CleanFilePath(fname);
293
294 arc := TTarArchive.Create;
295 arc.TarArchive := workdir + 'ipktar.tar';
296 arc.BaseDir := workdir;
297 arc.Compression:=cmXZ;
298 //Create dir struct
299 //ForceDirectories(ExtractFilePath(fdest));
300 //Check if package has signature
301 if arc.ExtractFile(fname) = 0 then
302 Result := true;
303
304 arc.Free;
305end;
306
307{ TLiUpdateBit }
308
309constructor TLiUpdateBit.Create;
310begin
311 inherited;
312 xz := TTarArchive.Create;
313 xz.Compression:=cmLZMA;
314end;
315
316destructor TLiUpdateBit.Destroy;
317begin
318 xz.Free;
319 inherited;
320end;
321
322procedure TLiUpdateBit.Compress(infile: String; outfile: String);
323begin
324 xz.BaseDir:=ExtractFilePath(infile);
325 xz.TarArchive:=outfile;
326 xz.AddFile(infile);
327 xz.Finalize;
328end;
329
330procedure TLiUpdateBit.Decompress(infile: String; outfile: String);
331begin
332 //NEEDS WORK!
333 xz.TarArchive:=infile;
334 xz.BaseDir:=ExtractFilePath(outfile);
335 xz.ExtractFile('*');
336end;
337
338end.
  
1{ Copyright (C) 2010 Matthias Klumpp
2
3 Authors:
4 Matthias Klumpp
5
6 This program is free software: you can redistribute it and/or modify it under
7 the terms of the GNU General Public License as published by the Free Software
8 Foundation, version 3.
9
10 This program is distributed in the hope that it will be useful, but WITHOUT
11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License v3
15 along with this program. If not, see <http://www.gnu.org/licenses/>.}
16//** Contains class to package signed and unsigned IPK package source files (IPK1.1 layout)
17unit ipkpackage11;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24 Classes, FileUtil, GPGSign, LiUtils, LiTypes, SysUtils, TarArchive;
25
26type
27 //** Creates IPK packages from preprocessed source files
28
29 { TLiPackager }
30
31 TLiPackager = class
32 private
33 OutFileName: String;
34 pkrandom: String;
35 basename: String;
36 mntar: TTarArchive;
37 finalized: Boolean;
38 bdir: String;
39 maxbytes: Int64;
40
41 function RandomID: String;
42 public
43 constructor Create(aIPKFile: String);
44 destructor Destroy; override;
45
46 //** Add a new file to the IPK structure @return False if already finalized or other error
47 function AddFile(fname: String): Boolean;
48 //** Finalize the base file for signing
49 procedure Finalize;
50 //** Sign the package
51 function SignPackage: Boolean;
52 //** Compress package and copy it to output @returns Success of operation
53 function ProduceIPKPackage: Boolean;
54 //** Base directory (root of package)
55 property BaseDir: String read bdir write bdir;
56 //** Set IPK file name
57 property IPKFile: String read OutFileName write OutFileName;
58 end;
59
60 //** Unpacks IPK package structure
61
62 { TLiUnpacker }
63
64 TLiUnpacker = class
65 private
66 ipkfile: String;
67 workdir: String;
68 signChecked: Boolean;
69 public
70 constructor Create(aIPKFile: String);
71 destructor Destroy; override;
72
73 //** Prepare IPK tar file for extracting
74 procedure Prepare;
75 //** Verify signature (if there is any)
76 function CheckSignature: TPkgSigState;
77 //** Unpack file @returns Success of operation
78 function UnpackFile(fname: String): Boolean;
79 //** Unpacker's working dir
80 property WDir: String read workdir;
81 end;
82
83 //** Create small LZMA compressed files for update sources
84 TLiUpdateBit = class
85 private
86 xz: TTarArchive;
87 public
88 constructor Create;
89 destructor Destroy; override;
90
91 //** Compress files to XZ
92 procedure Compress(infile: String; outfile: String);
93 //** Decompress a file
94 procedure Decompress(infile: String; outfile: String);
95 end;
96
97implementation
98
99{ TLiPackager }
100
101constructor TLiPackager.Create(aIPKFile: String);
102begin
103 inherited Create;
104 randomize;
105 pkrandom := '-' + RandomID + RandomID + RandomID;
106 finalized := false;
107 OutFileName := aIPKFile;
108 basename := tmpdir + ExtractFileName(OutFileName) + pkrandom + '.tar';
109 mntar := TTarArchive.Create;
110 mntar.Compression:=cmXZ; //IPK packages are XZ compressed
111 mntar.TarArchive := basename;
112end;
113
114destructor TLiPackager.Destroy;
115begin
116 if not finalized then
117 mntar.Free;
118 inherited;
119end;
120
121function TLiPackager.RandomID: String;
122begin
123 Result := IntToStr(random(99));
124end;
125
126function TLiPackager.AddFile(fname: String): Boolean;
127begin
128 if finalized then
129 Result := false
130 else
131 begin
132 mntar.BaseDir := bdir;
133 if mntar.AddFile(fname) = 0 then
134 Result := true
135 else
136 Result := false;
137 end;
138end;
139
140procedure TLiPackager.Finalize;
141begin
142 p_info('Finalizing package.');
143 if mntar.Finalize > 0 then
144 raise Exception.Create('Error while building package.');
145 mntar.Free;
146 finalized := true;
147end;
148
149function TLiPackager.SignPackage: Boolean;
150var
151 sign: TGPGSignWrapper;
152 oldbase: String;
153 rs: Integer;
154begin
155 Result := false;
156 if (not Finalized) then
157 raise Exception.Create('IPK file was not finalized before signing.');
158
159 oldbase := basename;
160 sign := TGPGSignWrapper.Create;
161 sign.FileName := oldbase;
162 Result := true;
163 if FileExistsUTF8(ExtractFilePath(oldbase) + '/signature.asc') then
164 DeleteFile(ExtractFilePath(oldbase) + '/signature.asc');
165
166 if not sign.Signfile(ExtractFilePath(oldbase) + '/signature.asc') then
167 begin
168 Result := false;
169 sign.Free;
170 exit;
171 end;
172 sign.Free;
173
174 pkrandom := '-' + RandomID + RandomID + RandomID;
175 basename := tmpdir + ExtractFileName(OutFileName) + pkrandom + '.tar';
176 mntar := TTarArchive.Create;
177 mntar.Compression:=cmNone; //No compression here
178 mntar.TarArchive := basename;
179
180 mntar.BaseDir := ExtractFilePath(oldbase);
181
182 RenameFile(oldbase, ExtractFilePath(oldbase) + '/content.tar');
183 oldbase := ExtractFilePath(oldbase) + '/content.tar';
184
185 rs := mntar.AddFile(oldbase);
186 if rs = 0 then
187 begin
188 rs := mntar.AddFile(ExtractFilePath(oldbase) + 'signature.asc');
189 if rs <> 0 then
190 raise Exception.Create('Error while combining signed package.');
191 end
192 else
193 raise Exception.Create('Error while combining signed package.');
194 mntar.Finalize;
195 mntar.Free;
196
197 DeleteFile(ExtractFilePath(oldbase) + 'signature.asc');
198 DeleteFile(oldbase);
199end;
200
201function TLiPackager.ProduceIPKPackage: Boolean;
202begin
203 Result := true;
204 if FileExists(OutFileName) then
205 Exception.Create('Output file already exists!');
206 if (not Finalized) then
207 raise Exception.Create('IPK file was not finalized.');
208
209 if not finalized then mntar.Finalize;
210
211 FileCopy(basename,outfilename);
212 DeleteFile(basename);
213end;
214
215{ TLiUnpacker }
216
217constructor TLiUnpacker.Create(aIPKFile: String);
218begin
219 inherited Create;
220 ipkfile := aIPKFile;
221 workdir := tmpdir + ExtractFileName(ipkfile) + '/';
222 SysUtils.ForceDirectories(workdir);
223 signChecked := false;
224end;
225
226destructor TLiUnpacker.Destroy;
227begin
228 inherited;
229end;
230
231procedure TLiUnpacker.Prepare;
232begin
233 if not FileExists(ipkfile) then
234 Exception.Create('IPK file does not exists!');
235
236 FileCopy(ipkfile, workdir+'ipktar.tar');
237 //Some more praparation later...
238end;
239
240function TLiUnpacker.CheckSignature: TPkgSigState;
241var
242 mnarc: TTarArchive;
243 hasSignature: Boolean;
244 sign: TGPGSignWrapper;
245 res: Integer;
246begin
247 hasSignature := false;
248 mnarc := TTarArchive.Create;
249 mnarc.TarArchive := workdir + 'ipktar.tar';
250 mnarc.Compression:=cmNone; //If we have a signature, covering tar is not compressed
251 mnarc.BaseDir := workdir;
252
253 Result := psNone;
254 //Check if package has signature
255 hasSignature := mnarc.FileInArchive('signature.asc');
256
257 if hasSignature then
258 begin
259 res := mnarc.ExtractFile('signature.asc');
260 res += mnarc.ExtractFile('content.tar');
261
262 if res <> 0 then
263 begin
264 //!!! This should be done better!
265 raise Exception.Create('Could not verify signature!');
266 end;
267
268 DeleteFile(workdir + 'ipktar.tar');
269 RenameFile(workdir + 'content.tar', workdir + 'ipktar.tar');
270 Result := psUntrusted;
271 //Now check signature
272 sign := TGPGSignWrapper.Create;
273 sign.FileName := workdir + 'ipktar.tar';
274 if sign.Verify(workdir + 'signature.asc') then
275 Result := psTrusted;
276 sign.Free;
277 end;
278 mnarc.Free;
279 signChecked := true;
280end;
281
282function TLiUnpacker.UnpackFile(fname: String): Boolean;
283var
284 arc: TTarArchive;
285begin
286 if not signChecked then
287 CheckSignature;
288 Result := false;
289 if length(fname) < 2 then
290 exit;
291
292 fname := CleanFilePath(fname);
293
294 arc := TTarArchive.Create;
295 arc.TarArchive := workdir + 'ipktar.tar';
296 arc.BaseDir := workdir;
297 arc.Compression:=cmXZ;
298 //Create dir struct
299 //ForceDirectories(ExtractFilePath(fdest));
300 //Check if package has signature
301 if arc.ExtractFile(fname) = 0 then
302 Result := true;
303
304 arc.Free;
305end;
306
307{ TLiUpdateBit }
308
309constructor TLiUpdateBit.Create;
310begin
311 inherited;
312 xz := TTarArchive.Create;
313 xz.Compression:=cmLZMA;
314end;
315
316destructor TLiUpdateBit.Destroy;
317begin
318 xz.Free;
319 inherited;
320end;
321
322procedure TLiUpdateBit.Compress(infile: String; outfile: String);
323begin
324 xz.BaseDir:=ExtractFilePath(infile);
325 xz.TarArchive:=outfile;
326 xz.AddFile(infile);
327 xz.Finalize;
328end;
329
330procedure TLiUpdateBit.Decompress(infile: String; outfile: String);
331begin
332 //NEEDS WORK!
333 xz.TarArchive:=infile;
334 xz.BaseDir:=ExtractFilePath(outfile);
335 xz.ExtractFile('*');
336end;
337
338end.
  
2222interface
2323
2424uses
25 MD5, Forms, Grids, Menus, editor, ipkdef, Buttons, Classes, Dialogs,
25 MD5, Forms, Grids, Menus, editor, IPKCDef10, Buttons, Classes, Dialogs,
2626 EditBtn, LCLType, LiTypes, liUtils, SynEdit, CheckLst, ComCtrls,
2727 Controls, ExtCtrls, FileCtrl, FileUtil, Graphics, StdCtrls,
28 SysUtils, IconLoader, LResources, popupnotifier;
28 SysUtils, IconLoader, LResources, PopupNotifier;
2929
3030type
3131
  
2424interface
2525
2626uses
27 Classes, SysUtils, LResources, GetText, Controls, typinfo, FileUtil,
28 LiUtils;
27 Classes, GetText, LiUtils, TypInfo, Controls, FileUtil,
28 SysUtils, LResources;
2929
3030type
31 TDefaultTranslator=class(TAbstractTranslator)
32 private
33 FMOFile:TMOFile;
34 public
35 constructor Create(MOFileName:string);
36 destructor Destroy;override;
37 procedure TranslateStringProperty(Sender:TObject; const Instance: TPersistent; PropInfo: PPropInfo; var Content:string);override;
38 end;
31 TDefaultTranslator = class(TAbstractTranslator)
32 private
33 FMOFile: TMOFile;
34 public
35 constructor Create(MOFileName: String);
36 destructor Destroy; override;
37 procedure TranslateStringProperty(Sender: TObject; const Instance: TPersistent;
38 PropInfo: PPropInfo; var Content: String); override;
39 end;
3940
4041implementation
42
4143uses Menus;
4244
43function FindLocaleFileName:string;
44var LANG,lng:string;
45function FindLocaleFileName: String;
46var
47 LANG, lng: String;
4548 i: Integer;
4649 liname: String;
4750begin
48 LANG:=GetEnvironmentVariableUTF8('LANG');
49 if LANG='' then begin
50 for i:=1 to Paramcount-1 do
51 if (ParamStrUTF8(i)='--LANG') or
52 (ParamStrUTF8(i)='-l') or
53 (ParamStrUTF8(i)='--lang') then LANG:=ParamStrUTF8(i+1);
54 end;
51 LANG := GetEnvironmentVariableUTF8('LANG');
52 if LANG = '' then
53 begin
54 for i := 1 to Paramcount - 1 do
55 if (ParamStrUTF8(i) = '--LANG') or (ParamStrUTF8(i) = '-l') or
56 (ParamStrUTF8(i) = '--lang') then
57 LANG := ParamStrUTF8(i + 1);
58 end;
5559
56 liname:='listaller';
60 liname := 'listaller';
5761
58 if LANG<>'' then begin
59 //ParamStrUTF8(0) is said not to work properly in linux, but I've tested it
60 Result:=ExtractFilePath(ParamStrUTF8(0))+LANG+
61 DirectorySeparator+liname+'.mo';
62 if FileExistsUTF8(Result) then exit;
62 if LANG <> '' then
63 begin
64 //ParamStrUTF8(0) is said not to work properly in linux, but I've tested it
65 Result := ExtractFilePath(ParamStrUTF8(0)) + LANG + DirectorySeparator + liname + '.mo';
66 if FileExistsUTF8(Result) then
67 exit;
6368
64 Result:=ExtractFilePath(ParamStrUTF8(0))+'languages'+DirectorySeparator+LANG+
65 DirectorySeparator+liname+'.mo';
66 if FileExistsUTF8(Result) then exit;
69 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + LANG +
70 DirectorySeparator + liname + '.mo';
71 if FileExistsUTF8(Result) then
72 exit;
6773
68 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator
69 +LANG+DirectorySeparator+liname+'.mo';
70 if FileExistsUTF8(Result) then exit;
74 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator
75 + LANG + DirectorySeparator + liname + '.mo';
76 if FileExistsUTF8(Result) then
77 exit;
7178
72 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator
73 +LANG+DirectorySeparator+'LC_MESSAGES'+DirectorySeparator+
74 liname+'.mo';
75 if FileExistsUTF8(Result) then exit;
79 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator
80 + LANG + DirectorySeparator + 'LC_MESSAGES' + DirectorySeparator + liname + '.mo';
81 if FileExistsUTF8(Result) then
82 exit;
7683
77 //In unix-like systems we can try to search for global locale
78 Result:='/usr/share/locale/'+LANG+'/LC_MESSAGES/'
79 +liname+'.mo';
80 if FileExistsUTF8(Result) then exit;
84 //In unix-like systems we can try to search for global locale
85 Result := '/usr/share/locale/' + LANG + '/LC_MESSAGES/' + liname + '.mo';
86 if FileExistsUTF8(Result) then
87 exit;
8188
82 //Let us search for reducted files
83 lng:=copy(LANG,1,2);
89 //Let us search for reducted files
90 lng := copy(LANG, 1, 2);
8491
85 Result:='/usr/share/listaller/locale/'+lng+'.mo';
86 if FileExistsUTF8(Result) then exit;
92 Result := '/usr/share/listaller/locale/' + lng + '.mo';
93 if FileExistsUTF8(Result) then
94 exit;
8795
88 Result:='/usr/share/listaller/locale/'+liname+'-'+lng+'.mo';
89 if FileExistsUTF8(Result) then exit;
96 Result := '/usr/share/listaller/locale/' + liname + '-' + lng + '.mo';
97 if FileExistsUTF8(Result) then
98 exit;
9099
91 Result:='/usr/share/listaller/locale/'+LANG+'.mo';
92 if FileExistsUTF8(Result) then exit;
100 Result := '/usr/share/listaller/locale/' + LANG + '.mo';
101 if FileExistsUTF8(Result) then
102 exit;
93103
94 Result:='/usr/share/listaller/locale/'+liname+'-'+LANG+'.mo';
95 if FileExistsUTF8(Result) then exit;
104 Result := '/usr/share/listaller/locale/' + liname + '-' + LANG + '.mo';
105 if FileExistsUTF8(Result) then
106 exit;
96107
97 //At first, check all was checked
98 Result:=ExtractFilePath(ParamStrUTF8(0))+lng+
99 DirectorySeparator+liname+'.mo';
100 if FileExistsUTF8(Result) then exit;
108 //At first, check all was checked
109 Result := ExtractFilePath(ParamStrUTF8(0)) + lng + DirectorySeparator + liname + '.mo';
110 if FileExistsUTF8(Result) then
111 exit;
101112
102 Result:=ExtractFilePath(ParamStrUTF8(0))+'languages'+DirectorySeparator+lng+
103 DirectorySeparator+liname+'.mo';
104 if FileExistsUTF8(Result) then exit;
113 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + lng +
114 DirectorySeparator + liname + '.mo';
115 if FileExistsUTF8(Result) then
116 exit;
105117
106 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator
107 +lng+DirectorySeparator+liname+'.mo';
108 if FileExistsUTF8(Result) then exit;
118 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator
119 + lng + DirectorySeparator + liname + '.mo';
120 if FileExistsUTF8(Result) then
121 exit;
109122
110 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator
111 +LANG+DirectorySeparator+'LC_MESSAGES'+DirectorySeparator+
112 liname+'.mo';
113 if FileExistsUTF8(Result) then exit;
123 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator
124 + LANG + DirectorySeparator + 'LC_MESSAGES' + DirectorySeparator + liname + '.mo';
125 if FileExistsUTF8(Result) then
126 exit;
114127
115 //Full language in file name - this will be default for the project
116 //We need more carefull handling, as it MAY result in incorrect filename
117 try
118 Result:=ExtractFilePath(ParamStrUTF8(0))+liname+'.'+LANG+'.mo';
119 if FileExistsUTF8(Result) then exit;
120 //Common location (like in Lazarus)
121 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator+liname+'.'+LANG+'.mo';
122 if FileExistsUTF8(Result) then exit;
128 //Full language in file name - this will be default for the project
129 //We need more carefull handling, as it MAY result in incorrect filename
130 try
131 Result := ExtractFilePath(ParamStrUTF8(0)) + liname + '.' + LANG + '.mo';
132 if FileExistsUTF8(Result) then
133 exit;
134 //Common location (like in Lazarus)
135 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator +
136 liname + '.' + LANG + '.mo';
137 if FileExistsUTF8(Result) then
138 exit;
123139
124 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator+liname+'-'+LANG+'.mo';
125 if FileExistsUTF8(Result) then exit;
140 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator +
141 liname + '-' + LANG + '.mo';
142 if FileExistsUTF8(Result) then
143 exit;
126144
127 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator+LANG+'.mo';
128 if FileExistsUTF8(Result) then exit;
145 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator + LANG + '.mo';
146 if FileExistsUTF8(Result) then
147 exit;
129148
130 Result:=ExtractFilePath(ParamStrUTF8(0))+'languages'+DirectorySeparator+liname+'.'+LANG+'.mo';
131 if FileExistsUTF8(Result) then exit;
132 except
133 end;
134 Result:='/usr/share/locale/'+lng+'/LC_MESSAGES/'
135 +liname+'.mo';
136 if FileExistsUTF8(Result) then exit;
149 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator +
150 liname + '.' + LANG + '.mo';
151 if FileExistsUTF8(Result) then
152 exit;
153 except
154 end;
155 Result := '/usr/share/locale/' + lng + '/LC_MESSAGES/' + liname + '.mo';
156 if FileExistsUTF8(Result) then
157 exit;
137158
138 Result:=ExtractFilePath(ParamStrUTF8(0))+liname+'.'+lng+'.mo';
139 if FileExistsUTF8(Result) then exit;
159 Result := ExtractFilePath(ParamStrUTF8(0)) + liname + '.' + lng + '.mo';
160 if FileExistsUTF8(Result) then
161 exit;
140162
141 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator+liname+'.'+lng+'.mo';
142 if FileExistsUTF8(Result) then exit;
163 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator +
164 liname + '.' + lng + '.mo';
165 if FileExistsUTF8(Result) then
166 exit;
143167
144 Result:=ExtractFilePath(ParamStrUTF8(0))+'locale'+DirectorySeparator+liname+'-'+lng+'.mo';
145 if FileExistsUTF8(Result) then exit;
168 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator +
169 liname + '-' + lng + '.mo';
170 if FileExistsUTF8(Result) then
171 exit;
146172
147 Result:=GetDataFile('/locale/'+liname+'-'+lng+'.mo');
148 if FileExistsUTF8(Result) then exit;
173 Result := GetDataFile('/locale/' + liname + '-' + lng + '.mo');
174 if FileExistsUTF8(Result) then
175 exit;
149176
150 Result:=ExtractFilePath(ParamStrUTF8(0))+'languages'+DirectorySeparator+liname+'.'+lng+'.mo';
151 if FileExistsUTF8(Result) then exit;
152 end;
153 Result:=ChangeFileExt(ParamStrUTF8(0),'.mo');
154 if FileExistsUTF8(Result) then exit;
177 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator +
178 liname + '.' + lng + '.mo';
179 if FileExistsUTF8(Result) then
180 exit;
181 end;
182 Result := ChangeFileExt(ParamStrUTF8(0), '.mo');
183 if FileExistsUTF8(Result) then
184 exit;
155185
156 Result:='';
186 Result := '';
157187end;
158var lcfn:string;
159188
189var
190 lcfn: String;
191
160192{ TDefaultTranslator }
161193
162constructor TDefaultTranslator.Create(MOFileName: string);
163var lng: String;
194constructor TDefaultTranslator.Create(MOFileName: String);
195var
196 lng: String;
164197begin
165198 inherited Create;
166 FMOFile:=TMOFile.Create(UTF8ToSys(MOFileName));
199 FMOFile := TMOFile.Create(UTF8ToSys(MOFileName));
167200
168 lng:=copy(GetEnvironmentVariableUTF8('LANG'),1,2);
169 if FileExistsUTF8('/usr/share/listaller/locale/lclstrconsts-'+lng+'.mo') then
170 TranslateResourceStrings('/usr/share/listaller/locale/lclstrconsts-'+lng+'.mo');
201 lng := copy(GetEnvironmentVariableUTF8('LANG'), 1, 2);
202 if FileExistsUTF8('/usr/share/listaller/locale/lclstrconsts-' + lng + '.mo') then
203 TranslateResourceStrings('/usr/share/listaller/locale/lclstrconsts-' + lng + '.mo');
171204end;
172205
173206destructor TDefaultTranslator.Destroy;
174207begin
175208 FMOFile.Free;
176//If someone will use this class incorrectly, it can be destroyed
177//before Reader destroying. It is a very bad thing, but in THIS situation
178//in this case is impossible. May be, in future we can overcome this difficulty
209 //If someone will use this class incorrectly, it can be destroyed
210 //before Reader destroying. It is a very bad thing, but in THIS situation
211 //in this case is impossible. May be, in future we can overcome this difficulty
179212 inherited Destroy;
180213end;
181214
182215procedure TDefaultTranslator.TranslateStringProperty(Sender: TObject;
183 const Instance: TPersistent; PropInfo: PPropInfo; var Content: string);
216 const Instance: TPersistent; PropInfo: PPropInfo; var Content: String);
184217var
185218 s: String;
186219begin
187 if not Assigned(FMOFile) then exit;
188 if not Assigned(PropInfo) then exit;
189{DO we really need this?}
220 if not Assigned(FMOFile) then
221 exit;
222 if not Assigned(PropInfo) then
223 exit;
224 {DO we really need this?}
190225 if Instance is TComponent then
191 if csDesigning in (Instance as TComponent).ComponentState then exit;
192{End DO :)}
193 if (AnsiUpperCase(PropInfo^.PropType^.Name)<>'TTRANSLATESTRING') then exit;
194 s:=FMOFile.Translate(Content);
195 if s<>'' then Content:=s;
226 if csDesigning in (Instance as TComponent).ComponentState then
227 exit;
228 {End DO :)}
229 if (AnsiUpperCase(PropInfo^.PropType^.Name) <> 'TTRANSLATESTRING') then
230 exit;
231 s := FMOFile.Translate(Content);
232 if s <> '' then
233 Content := s;
196234end;
197235
198var Dot1:integer;
199 LCLPath:string;
236var
237 Dot1: Integer;
238 LCLPath: String;
239
200240initialization
201//It is safe to place code here as no form is initialized before unit
202//initialization made
203//We are to search for all
241 //It is safe to place code here as no form is initialized before unit
242 //initialization made
243 //We are to search for all
204244 try
205 lcfn:=FindLocaleFileName;
245 lcfn := FindLocaleFileName;
206246 except
207 lcfn:='';
247 lcfn := '';
208248 end;
209249
210 if lcfn<>'' then
250 if lcfn <> '' then
211251 begin
212252 TranslateResourceStrings(UTF8ToSys(lcfn));
213 LCLPath:=ExtractFileName(lcfn);
214 Dot1:=pos('.',LCLPath);
253 LCLPath := ExtractFileName(lcfn);
254 Dot1 := pos('.', LCLPath);
215255
216 if Dot1>1 then
256 if Dot1 > 1 then
217257 begin
218 Delete(LCLPath,1,Dot1-1);
219 LCLPath:=ExtractFilePath(lcfn)+'lcl'+LCLPath;
258 Delete(LCLPath, 1, Dot1 - 1);
259 LCLPath := ExtractFilePath(lcfn) + 'lcl' + LCLPath;
220260 if FileExistsUTF8(LCLPath) then
221261 TranslateResourceStrings(UTF8ToSys(LCLPath));
222262 end;
223263
224 LRSTranslator:=TDefaultTranslator.Create(lcfn);
264 LRSTranslator := TDefaultTranslator.Create(lcfn);
225265
226266 end;
227267
  
1#!/bin/sh -e
2#
3# signipk
4# Copyright (C) 2010 Matthias Klumpp
5#
6# Authors: Matthias Klumpp <matthias@nlinux.org>
7#
8# This program is free software: you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation, version 3 of the License.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19OPTION_SPEC="help,sign"
20PARSED_OPTIONS=$(getopt -n "$0" -a -o hp: --l "$OPTION_SPEC" -- "$@")
21
22eval set -- "$PARSED_OPTIONS"
23
24function usage
25{
26 echo "Usage:"
27 echo "signipk <options> [parameters]"
28 echo "Sign IPK packages using GPG."
29}
30
31if [ $? != 0 ] ; then usage ; exit 1 ; fi
32
33INSTALL_DEV_FILES=1
34
35while true ; do
36 case "$1" in
37 -h|--help ) usage; exit 0;;
38 --sign ) SIGN=1; shift; ;;
39 -p ) case "$2" in
40 "") echo "No package specified!"; exit 3 ;;
41 *) export libtarget=$2 ; shift 2 ;;
42 esac ;;
43 --) shift ; break ;;
44 * ) echo "ERROR: unknown flag $1"; exit 2;;
45 esac
46done
47
48#Sign package here!