2 curl.maxtime<-60*60 # 60 minutes max download time (some bioconductor packages are truly big and take time)
3 curl.retries<-0 # No retries (connections are commonly good enough)
6 # set up the working directory
7 tmp <- tempfile('cran2deb')
12 cleanup <- function(dir) {
13 # remove the working directory
14 unlink(dir,recursive=T)
18 download_pkg <- function(dir, pkgname, repacking=0) {
19 # download pkgname into dir, and construct some metadata
21 # record some basic information
23 pkg$date_stamp = Sys.time()
25 pkg$repoURL = available[pkgname,'Repository']
26 pkg$repo = repourl_as_debian(pkg$repoURL)
27 if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) {
28 fail('Cannot convert package name into a Debian name',pkg$name)
30 pkg$srcname = pkgname_as_debian(pkg$name,binary=F)
31 pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo)
32 pkg$version <- available[pkgname,'Version']
34 # see if we have already built this release and uploaded it.
35 debfn <- file.path(pbuilder_results, paste(pkg$srcname, '_', pkg$version, '.orig.tar.gz', sep=''))
36 pkg$need_repack = FALSE
37 if (file.exists(debfn)) {
38 # if so, use the existing archive. this is good for three reasons:
39 # 1. it saves downloading the archive again
40 # 2. the repacking performed below changes the MD5 sum of the archive
41 # which upsets some Debian archive software.
42 # 3. why repack more than once?
43 pkg$archive <- file.path(dir, basename(debfn))
44 file.copy(debfn,pkg$archive)
45 pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-'))
46 notice('using an existing debianized source tarball:',debfn)
48 # see if we have a local mirror in /srv/R
50 if (pkg$repo == 'cran') {
51 localfn = file.path('/srv/R/Repositories/CRAN/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep=''))
52 use_local = file.exists(localfn)
53 } else if (pkg$repo == 'bioc') {
54 localfn = file.path('/srv/R/Repositories/Bioconductor/release/bioc/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep=''))
55 use_local = file.exists(localfn)
58 fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='')
59 archive <- file.path(dir, fn)
62 file.copy(localfn, archive)
64 # use this instead of download.packages as it is more resilient to
65 # dodgy network connections (hello BT 'OpenWorld', bad ISP)
66 url <- paste(available[pkgname,'Repository'], fn, sep='/')
67 # don't log the output -- we don't care!
68 ret <- system(paste('curl','-o',shQuote(archive),
69 paste('-m',curl.maxtime,'--retry',curl.retries,sep=' '),
72 fail('failed to download',url)
74 # end of download.packages replacement
77 if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) {
78 fail('funny looking path',archive)
80 pkg$path = sub("_\\.(zip|tar\\.gz)", ""
81 ,gsub(.standard_regexps()$valid_package_version, ""
84 # this is not a Debian conformant archive
85 ## we basically should never repack
86 ## pkg$need_repack = TRUE
91 repack_pkg <- function(pkg) {
92 # re-pack into a Debian-named archive with a Debian-named directory.
93 notice('repacking into debian source archive.')
94 debpath = file.path(dirname(pkg$archive)
98 file.rename(pkg$path, debpath)
100 debarchive = file.path(dirname(pkg$archive)
101 ,paste(pkg$srcname,'_'
102 ,pkg$version,'.orig.tar.gz'
105 setwd(dirname(pkg$path))
106 # remove them pesky +x files
107 # BUT EXCLUDE configure and cleanup
108 log_system('find',shQuote(basename(pkg$path))
110 , '! \\( -name configure -o -name cleanup \\)'
111 ,'-exec chmod -x {} \\;')
112 if (file.exists(file.path(basename(pkg$path),'debian'))) {
113 warn('debian/ directory found in tarball! removing...')
114 unlink(file.path(basename(pkg$path),'debian'),recursive=TRUE)
117 log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path)))
119 file.remove(pkg$archive)
120 pkg$archive = debarchive
121 pkg$need_repack = FALSE
125 prepare_pkg <- function(dir, pkgname) {
126 # download and extract an R package named pkgname
128 # based loosely on library/utils/R/packages2.R::install.packages
130 # grab the archive and some metadata
131 pkg <- download_pkg(dir, pkgname)
133 # now extract the archive
134 if (!length(grep('\\.tar\\.gz',pkg$archive))) {
135 fail('archive is not tarball')
139 ret = log_system('tar','xzf',shQuote(pkg$archive))
142 fail('Extraction of archive',pkg$archive,'failed.')
145 # if necessary, repack the archive into Debian-conformant format
146 if (pkg$need_repack) {
147 pkg <- repack_pkg(pkg)
149 log_system('ln','-sf',shQuote(pkg$archive),
150 shQuote(file.path(dirname(pkg$archive)
151 ,paste(pkg$srcname,'_'
152 ,pkg$version,'.orig.tar.gz'
155 if (!file.info(pkg$path)[,'isdir']) {
156 fail(pkg$path,'is not a directory and should be.')
159 # extract the DESCRIPTION file, which contains much metadata
160 pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION'))
162 # ensure consistency of version numbers
163 if ('Version' %in% names(pkg$description[1,])) {
164 if (pkg$description[1,'Version'] != available[pkg$name,'Version']) {
165 # should never happen since available is the basis upon which the
166 # package is retrieved.
167 error('available version:',available[pkg$name,'Version'])
168 error('package version:',pkg$description[1,'Version'])
169 fail('inconsistency between R package version and cached R version')
173 # note subtly of short circuit operators (no absorption)
174 if (pkg$description[1,'Package'] != pkg$name) {
175 fail('package name mismatch')