X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=branch%2Fsplit_build%2FR%2Fgetrpkg.R;fp=branch%2Fsplit_build%2FR%2Fgetrpkg.R;h=38d7a590c9ed1eef1b737ecf2d998bf6b7fd5d2c;hb=42bff07893104a11db95c8d65fe518a336463351;hp=0000000000000000000000000000000000000000;hpb=f0817a2fbc3df0f5daad0a9e1a11d9f295218c0a;p=cran2deb.git diff --git a/branch/split_build/R/getrpkg.R b/branch/split_build/R/getrpkg.R new file mode 100644 index 0000000..38d7a59 --- /dev/null +++ b/branch/split_build/R/getrpkg.R @@ -0,0 +1,166 @@ +setup <- function() { + # set up the working directory + tmp <- tempfile('cran2deb') + dir.create(tmp) + return (tmp) +} + +cleanup <- function(dir) { + # remove the working directory + unlink(dir,recursive=T) + invisible() +} + +download_pkg <- function(dir, pkgname) { + # download pkgname into dir, and construct some metadata + + # record some basic information + pkg <- pairlist() + pkg$date_stamp = Sys.time() + pkg$name = pkgname + pkg$repoURL = available[pkgname,'Repository'] + pkg$repo = repourl_as_debian(pkg$repoURL) + if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) { + fail('Cannot convert package name into a Debian name',pkg$name) + } + pkg$srcname = pkgname_as_debian(pkg$name,binary=F) + pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo) + pkg$version <- available[pkgname,'Version'] + + # see if we have already built this release and uploaded it. + debfn <- get_reprepro_orig_tgz(pkg$srcname, pkg$version) + pkg$need_repack = FALSE + if (file.exists(debfn)) { + # if so, use the existing archive. this is good for three reasons: + # 1. it saves downloading the archive again + # 2. the repacking performed below changes the MD5 sum of the archive + # which upsets some Debian archive software. + # 3. why repack more than once? + pkg$archive <- file.path(dir, basename(debfn)) + file.copy(debfn,pkg$archive) + pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-')) + notice('using an existing debianized source tarball:',debfn) + } else { + # see if we have a local mirror in /srv/R + use_local = FALSE + if (pkg$repo == 'cran') { + localfn = file.path('/srv/R/Repositories/CRAN/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) + use_local = file.exists(localfn) + } else if (pkg$repo == 'bioc') { + localfn = file.path('/srv/R/Repositories/Bioconductor/release/bioc/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) + use_local = file.exists(localfn) + } + + fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='') + archive <- file.path(dir, fn) + + if (use_local) { + file.copy(localfn, archive) + } else { + # use this instead of download.packages as it is more resilient to + # dodgy network connections (hello BT 'OpenWorld', bad ISP) + url <- paste(available[pkgname,'Repository'], fn, sep='/') + # don't log the output -- we don't care! + ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url))) + if (ret != 0) { + fail('failed to download',url) + } + # end of download.packages replacement + } + + if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) { + fail('funny looking path',archive) + } + pkg$path = sub("_\\.(zip|tar\\.gz)", "" + ,gsub(.standard_regexps()$valid_package_version, "" + ,archive)) + pkg$archive = archive + # this is not a Debian conformant archive + pkg$need_repack = TRUE + } + return(pkg) +} + +repack_pkg <- function(pkg) { + # re-pack into a Debian-named archive with a Debian-named directory. + notice('repacking into debian source archive.') + debpath = file.path(dirname(pkg$archive) + ,paste(pkg$srcname + ,pkg$version + ,sep='-')) + file.rename(pkg$path, debpath) + pkg$path = debpath + debarchive = file.path(dirname(pkg$archive) + ,paste(pkg$srcname,'_' + ,pkg$version,'.orig.tar.gz' + ,sep='')) + wd <- getwd() + setwd(dirname(pkg$path)) + # remove them pesky +x files + # BUT EXCLUDE configure and cleanup + log_system('find',shQuote(basename(pkg$path)) + ,'-type f -a ' + , '! \\( -name configure -o -name cleanup \\)' + ,'-exec chmod -x {} \\;') + if (file.exists(file.path(basename(pkg$path),'debian'))) { + warn('debian/ directory found in tarball! removing...') + unlink(file.path(basename(pkg$path),'debian'),recursive=TRUE) + } + # tar it all back up + log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))) + setwd(wd) + file.remove(pkg$archive) + pkg$archive = debarchive + pkg$need_repack = FALSE + return(pkg) +} + +prepare_pkg <- function(dir, pkgname) { + # download and extract an R package named pkgname + + # based loosely on library/utils/R/packages2.R::install.packages + + # grab the archive and some metadata + pkg <- download_pkg(dir, pkgname) + + # now extract the archive + if (!length(grep('\\.tar\\.gz',pkg$archive))) { + fail('archive is not tarball') + } + wd <- getwd() + setwd(dir) + ret = log_system('tar','xzf',shQuote(pkg$archive)) + setwd(wd) + if (ret != 0) { + fail('Extraction of archive',pkg$archive,'failed.') + } + + # if necessary, repack the archive into Debian-conformant format + if (pkg$need_repack) { + pkg <- repack_pkg(pkg) + } + if (!file.info(pkg$path)[,'isdir']) { + fail(pkg$path,'is not a directory and should be.') + } + + # extract the DESCRIPTION file, which contains much metadata + pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) + + # ensure consistency of version numbers + if ('Version' %in% names(pkg$description[1,])) { + if (pkg$description[1,'Version'] != available[pkg$name,'Version']) { + # should never happen since available is the basis upon which the + # package is retrieved. + error('available version:',available[pkg$name,'Version']) + error('package version:',pkg$description[1,'Version']) + fail('inconsistency between R package version and cached R version') + } + } + + # note subtly of short circuit operators (no absorption) + if (pkg$description[1,'Package'] != pkg$name) { + fail('package name mismatch') + } + return(pkg) +} +