Opera 12.15 Source Code
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

repacker.pm 7.4KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324
  1. #!perl # -*- tab-width: 4; fill-column: 80 -*-
  2. ############################################################
  3. #
  4. # Module used to unpack and modify existing packages
  5. #
  6. ############################################################
  7. use strict;
  8. package repacker;
  9. use File::Spec;
  10. use File::Basename;
  11. use LWP::UserAgent;
  12. sub new
  13. {
  14. my $class = shift;
  15. my $self = {};
  16. $self->{_working_dir} = shift;
  17. $self->{_unpack_cache} = shift;
  18. $self->{_files_list} = undef;
  19. $self->{_package_dir} = undef;
  20. $self->{_package_ready} = 0;
  21. $self->{_opera_next} = undef;
  22. $self->{_packaging_dir} = dirname(File::Spec->rel2abs(__FILE__));
  23. if (!(-d $self->{_unpack_cache}) || !(-d $self->{_working_dir}))
  24. {
  25. return undef;
  26. }
  27. bless $self, $class;
  28. return $self;
  29. }
  30. sub GetPackageOnline
  31. {
  32. my $build_nr = shift;
  33. my $opera_next = shift;
  34. my $ver_major = shift;
  35. my $ver_minor = shift;
  36. my $architecture = shift;
  37. my $destination = shift;
  38. if ($build_nr !~ /[\d]{4,5}/)
  39. {
  40. print "Invalid build number: $build_nr\n";
  41. return 0;
  42. }
  43. my $ver = $ver_major.".".$ver_minor;
  44. my $source_exe = "http://bcd-portal.oslo.opera.com/builds/desktop/windows/".$ver."/".$build_nr."/Opera-".($opera_next?"Next-":"").$ver."-".$build_nr.".".$architecture.".autoupdate.exe";
  45. my $destination_exe = File::Spec->catfile($destination, "Opera_package.exe");
  46. if (-e $destination_exe)
  47. {
  48. return $destination_exe;
  49. }
  50. print "Downloading $source_exe to $destination_exe";
  51. my $lwp_ua = LWP::UserAgent->new();
  52. my $req = new HTTP::Request(GET=>$source_exe);
  53. $req->authorization_basic("bcd-bot", "o3xp,bq?");
  54. my $resp = $lwp_ua->request($req, $destination_exe);
  55. if (!(-e $destination_exe))
  56. {
  57. return 0;
  58. }
  59. return $destination_exe;
  60. }
  61. sub Unpack
  62. {
  63. my $package = shift;
  64. my $destination = shift;
  65. if (!(-e $package))
  66. {
  67. return 0;
  68. }
  69. print "Extracting $package to $destination:\n";
  70. system("7z x \"$package\" -o\"$destination\"");
  71. return 1;
  72. }
  73. sub PrepareRepack
  74. {
  75. my $self = shift;
  76. my $ver_major = shift;
  77. my $ver_minor = shift;
  78. my $build_nr = shift;
  79. my $architecture = shift;
  80. my $opera_next = shift;
  81. $self->{_opera_next} = $opera_next;
  82. my $ver = $ver_major.$ver_minor;
  83. my $package_folder = File::Spec->catdir($self->{_unpack_cache}, "Opera-".($opera_next?"Next-":"").$ver."-".$build_nr.".".$architecture);
  84. my $unpacked_folder = File::Spec->catdir($package_folder, "package");
  85. print "Preparing repack of opera".($opera_next?" Next":"")." $ver_major.$ver_minor $build_nr $architecture\n";
  86. if (!(-d $unpacked_folder))
  87. {
  88. print "Unpacked folder not found in cache. Downloading.\n";
  89. if (!(-d $package_folder))
  90. {
  91. mkdir($package_folder);
  92. }
  93. my $package = GetPackageOnline($build_nr, $opera_next, $ver_major, $ver_minor, $architecture, $package_folder);
  94. if (!$package)
  95. {
  96. return 0;
  97. }
  98. if (Unpack($package, $unpacked_folder) == 0)
  99. {
  100. return 0;
  101. }
  102. }
  103. #Cleans the folder where the package will be put together
  104. File::Path::rmtree($self->{_working_dir}, {keep_root=>1});
  105. $self->{_package_dir} = File::Spec->catdir($self->{_working_dir}, "package");
  106. mkdir $self->{_package_dir};
  107. print "Copying $unpacked_folder to $self->{_package_dir}: \n";
  108. my $copy_command = "xcopy \"$unpacked_folder\\*.*\" \"".$self->{_package_dir}."\" /e /v /q /y";
  109. system($copy_command);
  110. my $files_list_file = File::Spec->catfile($self->{_package_dir}, 'files_list');
  111. if (!(-e $files_list_file))
  112. {
  113. print "Files list not found: $files_list_file\n";
  114. return 0;
  115. }
  116. open FILES_LIST, $files_list_file;
  117. $self->{_files_list} = [<FILES_LIST>];
  118. chomp @{$self->{_files_list}};
  119. close FILES_LIST;
  120. $self->{_package_ready} = 1;
  121. }
  122. sub FilterLanguages()
  123. {
  124. my $self = shift;
  125. my $languages_array = shift;
  126. my %languages;
  127. @languages{@{$languages_array}} = ();
  128. if (!$self->{_package_ready})
  129. {
  130. return 0;
  131. }
  132. print "Filtering languages list\n";
  133. my $locale_folder = File::Spec->catdir($self->{_package_dir}, 'locale');
  134. opendir LOCALES, $locale_folder;
  135. while (my $langdir = readdir(LOCALES))
  136. {
  137. if (!($langdir eq '.') && !($langdir eq '..') && !($langdir eq 'en') && !(exists $languages{$langdir}))
  138. {
  139. my $full_lang_dir = File::Spec->catdir($locale_folder, $langdir);
  140. File::Path::rmtree($full_lang_dir);
  141. }
  142. if (($langdir eq 'en') && !(exists $languages{$langdir}))
  143. {
  144. opendir EN_LOCALE, File::Spec->catdir($locale_folder, $langdir);
  145. while (my $enfile = readdir(EN_LOCALE))
  146. {
  147. if (!($enfile eq '.') && !($enfile eq '..') && !($enfile eq 'license.txt'))
  148. {
  149. unlink File::Spec->catfile($locale_folder, $langdir, $enfile);
  150. }
  151. }
  152. closedir EN_LOCALE;
  153. }
  154. }
  155. closedir LOCALES;
  156. my $i;
  157. for ($i = 0; $i < scalar @{$self->{_files_list}}; $i++)
  158. {
  159. my $item = $self->{_files_list}->[$i];
  160. if ($item =~ /^locale\\([^\\]+)\\/ && !(exists $languages{$1}) && !($item eq 'locale\\en\\license.txt'))
  161. {
  162. splice(@{$self->{_files_list}}, $i, 1);
  163. $i--;
  164. }
  165. }
  166. return 1;
  167. }
  168. sub CopyNewContent()
  169. {
  170. my $self = shift;
  171. my $content_folder = shift;
  172. if (!$self->{_package_ready})
  173. {
  174. return 0;
  175. }
  176. my $copy_cmd = "xcopy \"".$content_folder."\" \"".$self->{_package_dir}."\" /E /V /Q /Y";
  177. print "Copying files over: $copy_cmd\n";
  178. system($copy_cmd);
  179. return 1;
  180. }
  181. sub AddNewFilesList()
  182. {
  183. my $self = shift;
  184. my $new_files_list = shift;
  185. if (!$self->{_package_ready})
  186. {
  187. return 0;
  188. }
  189. print "Adding new files to the files list\n";
  190. push(@{$self->{_files_list}}, @{$new_files_list});
  191. return 1;
  192. }
  193. sub Repack()
  194. {
  195. my $self = shift;
  196. my $output_file = shift;
  197. my $output_autoupdate_file = shift;
  198. my $sign = shift;
  199. if (!$self->{_package_ready})
  200. {
  201. return 0;
  202. }
  203. my $files_list_file = File::Spec->catfile($self->{_package_dir}, 'files_list');
  204. my $sfx_dir = File::Spec->catdir($self->{_packaging_dir}, 'tools', '7zSfx');
  205. my $sfx_module;
  206. if (!$self->{_opera_next})
  207. {
  208. $sfx_module = File::Spec->catfile($sfx_dir, '7zsd.sfx');
  209. }
  210. else
  211. {
  212. $sfx_module = File::Spec->catfile($sfx_dir, '7zsd_Next.sfx');
  213. }
  214. my $sfx_config = File::Spec->catfile($sfx_dir, 'config.txt');
  215. my $sfx_autoupdate_config = File::Spec->catfile($sfx_dir, 'config_autoupdate.txt');
  216. my $installer_archive = File::Spec->catfile($self->{_working_dir}, 'Opera installer.7z');
  217. my $signcode = File::Spec->catdir($self->{_packaging_dir}, 'tools', 'signcode');
  218. my $signcode_command = "\"".$signcode. "\" -spc \"C:\\opera2010.spc\" -v \"C:\\opera2010.pvk\" -n \"Opera web browser\" -i \"http://www.opera.com\" -a MD5 -t \"http://timestamp.verisign.com/scripts/timstamp.dll\" ";
  219. open FILES_LIST, ">", $files_list_file;
  220. print FILES_LIST join("\n", @{$self->{_files_list}})."\n";
  221. close FILES_LIST;
  222. my $cwd = Cwd::getcwd();
  223. chdir ($self->{_package_dir});
  224. unlink($installer_archive);
  225. print "Zipping the Opera Installer:\n";
  226. system("7z a -t7z -mx9 -y \"$installer_archive\" . -xr!profile -xr!thumbs.db -xr!debug_log.txt -xr!debug.txt -xr!7z.log");
  227. if (defined $output_file)
  228. {
  229. print "Copying the Opera Installer to \"$output_file\"\n";
  230. system("copy /b \"$sfx_module\" + \"$sfx_config\" + \"$installer_archive\" \"$output_file\"");
  231. if ($sign)
  232. {
  233. system("$signcode_command \"$output_file\"");
  234. }
  235. }
  236. if (defined $output_autoupdate_file)
  237. {
  238. print "Copying the Opera Installer to \"$output_autoupdate_file\"\n";
  239. system("copy /b \"$sfx_module\" + \"$sfx_autoupdate_config\" + \"$installer_archive\" \"$output_autoupdate_file\"");
  240. if ($sign)
  241. {
  242. system("$signcode_command \"$output_autoupdate_file\"");
  243. }
  244. }
  245. chdir ($cwd);
  246. return 1;
  247. }
  248. return 1;