2 # set up the working directory
3 tmp <- tempfile('cran2deb')
8 cleanup <- function(dir) {
9 # remove the working directory
10 unlink(dir,recursive=T)
14 download_pkg <- function(dir, pkgname) {
15 # download pkgname into dir, and construct some metadata
17 # record some basic information
19 pkg$date_stamp = format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z')
21 pkg$repoURL = available[pkgname,'Repository']
22 pkg$repo = repourl_as_debian(pkg$repoURL)
23 if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) {
24 fail('Cannot convert package name into a Debian name',pkg$name)
26 pkg$srcname = pkgname_as_debian(pkg$name,binary=F)
27 pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo)
28 pkg$version <- available[pkgname,'Version']
30 # see if we have already built this release and uploaded it.
31 debfn <- file.path(pbuilder_results, paste(pkg$srcname, '_', pkg$version, '.orig.tar.gz', sep=''))
32 pkg$need_repack = FALSE
33 if (file.exists(debfn)) {
34 # if so, use the existing archive. this is good for three reasons:
35 # 1. it saves downloading the archive again
36 # 2. the repacking performed below changes the MD5 sum of the archive
37 # which upsets some Debian archive software.
38 # 3. why repack more than once?
39 pkg$archive <- file.path(dir, basename(debfn))
40 file.copy(debfn,pkg$archive)
41 pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-'))
43 # see if we have a local mirror in /srv/R
45 if (pkg$repo == 'cran') {
46 localfn = file.path('/srv/R/Repositories/CRAN/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep=''))
47 use_local = file.exists(localfn)
48 } else if (pkg$repo == 'bioc') {
49 localfn = file.path('/srv/R/Repositories/Bioconductor/release/bioc/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep=''))
50 use_local = file.exists(localfn)
53 fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='')
54 archive <- file.path(dir, fn)
57 file.copy(localfn, archive)
59 # use this instead of download.packages as it is more resilient to
60 # dodgy network connections (hello BT 'OpenWorld', bad ISP)
61 url <- paste(available[pkgname,'Repository'], fn, sep='/')
62 # don't log the output -- we don't care!
63 ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url)))
65 fail('failed to download',url)
67 # end of download.packages replacement
70 if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) {
71 fail('funny looking path',archive)
73 pkg$path = sub("_\\.(zip|tar\\.gz)", ""
74 ,gsub(.standard_regexps()$valid_package_version, ""
77 # this is not a Debian conformant archive
78 pkg$need_repack = TRUE
83 repack_pkg <- function(pkg) {
84 # re-pack into a Debian-named archive with a Debian-named directory.
85 debpath = file.path(dirname(pkg$archive)
89 file.rename(pkg$path, debpath)
91 debarchive = file.path(dirname(pkg$archive)
92 ,paste(pkg$srcname,'_'
93 ,pkg$version,'.orig.tar.gz'
96 setwd(dirname(pkg$path))
97 # remove them pesky +x files
98 # BUT EXCLUDE configure and cleanup
99 log_system('find',shQuote(basename(pkg$path))
101 , '! \\( -name configure -o -name cleanup \\)'
102 ,'-exec chmod -x {} \\;')
104 log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path)))
106 file.remove(pkg$archive)
107 pkg$archive = debarchive
108 pkg$need_repack = FALSE
112 prepare_pkg <- function(dir, pkgname) {
113 # download and extract an R package named pkgname
114 # OR the bundle containing pkgname
116 # based loosely on library/utils/R/packages2.R::install.packages
118 # first a little trick; change pkgname if pkgname is contained in a bundle
119 if (!(pkgname %in% rownames(available))) {
120 bundle <- r_bundle_of(pkgname)
121 if (is.null(bundle)) {
122 fail('package',pkgname,'is unavailable')
127 # grab the archive and some metadata
128 pkg <- download_pkg(dir, pkgname)
130 # now extract the archive
131 if (!length(grep('\\.tar\\.gz',pkg$archive))) {
132 fail('archive is not tarball')
136 ret = log_system('tar','xzf',shQuote(pkg$archive))
139 fail('Extraction of archive',pkg$archive,'failed.')
142 # if necessary, repack the archive into Debian-conformant format
143 if (pkg$need_repack) {
144 pkg <- repack_pkg(pkg)
146 if (!file.info(pkg$path)[,'isdir']) {
147 fail(pkg$path,'is not a directory and should be.')
150 # extract the DESCRIPTION file, which contains much metadata
151 pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION'))
153 # ensure consistency of version numbers
154 if ('Version' %in% names(pkg$description[1,])) {
155 if (pkg$description[1,'Version'] != available[pkg$name,'Version']) {
156 # should never happen since available is the basis upon which the
157 # package is retrieved.
158 error('available version:',available[pkg$name,'Version'])
159 error('package version:',pkg$description[1,'Version'])
160 fail('inconsistency between R package version and cached R version')
164 pkg$is_bundle = 'Bundle' %in% names(pkg$description[1,])
165 # note subtly of short circuit operators (no absorption)
166 if ((!pkg$is_bundle && pkg$description[1,'Package'] != pkg$name) ||
167 ( pkg$is_bundle && pkg$description[1,'Bundle'] != pkg$name)) {
168 fail('package name mismatch')