1#  File src/library/utils/R/sessionInfo.R
2#  Part of the R package, https://www.R-project.org
3#
4#  Copyright (C) 1995-2021 The R Core Team
5#
6#  This program is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  (at your option) any later version.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  A copy of the GNU General Public License is available at
17#  https://www.R-project.org/Licenses/
18
19.RNGdefaults <- RNGkind() # run once at install time and retain for comparison
20
21## FIXME?  alternatively, just define 'osVersion' directly in .onLoad()  in zzz.R
22.osVersion <- function() {
23    ## Now try to figure out the OS we are running under
24    if (.Platform$OS.type == "windows") {
25        win.version()
26    } else if (nzchar(Sys.which('uname'))) { ## we could try /usr/bin/uname
27        uname <- system("uname -a", intern = TRUE)
28        os <- sub(" .*", "", uname)
29        switch(os,
30               "Linux" =
31                   if(file.exists("/etc/os-release")) {
32                       ## http://www.freedesktop.org/software/systemd/man/os-release.html
33                       tmp <- readLines("/etc/os-release")
34                       t2 <- if (any(startsWith(tmp, "PRETTY_NAME=")))
35                                 sub("^PRETTY_NAME=", "",
36                                     grep("^PRETTY_NAME=", tmp, value = TRUE)[1L])
37                             else if (any(startsWith(tmp, "NAME")))
38                                 ## could check for VERSION or VERSION_ID
39                                 sub("^NAME=", "",
40                                     grep("^NAME=", tmp, value = TRUE)[1L])
41                             else "Linux (unknown distro)"
42                       sub('"(.*)"', "\\1", t2)
43                   } else if(file.exists("/etc/system-release")) {
44                       ## RHEL-like
45                       readLines("/etc/system-release")
46                   },
47               "Darwin" = {
48                   ver <- readLines("/System/Library/CoreServices/SystemVersion.plist")
49                   ind <- grep("ProductUserVisibleVersion", ver)
50                   ver <- ver[ind + 1L]
51                   ver <- sub(".*<string>", "", ver)
52                   ver <- sub("</string>$", "", ver)
53                   ver1 <- strsplit(ver, ".", fixed = TRUE)[[1L]]
54                   ver2 <- ver1[2L]
55                   if(ver1[1L] == "10")
56                       sprintf("%s %s %s",
57                               ifelse(as.numeric(ver2) < 12, "OS X", "macOS"),
58                               switch(ver2,
59                                      ## 10.6 is earliest that can be installed
60                                      "6" = "Snow Leopard",
61                                      "7" = "Lion",
62                                      "8" = "Mountain Lion",
63                                      "9" = "Mavericks",
64                                      "10" = "Yosemite",
65                                      "11" = "El Capitan",
66                                      "12" = "Sierra",
67                                      "13" = "High Sierra",
68                                      "14" = "Mojave",
69                                      "15" = "Catalina",
70                                      ## used for early pre-releases
71                                      ## and still reported by Xcode 10's SDK
72                                      "16" = "Big Sur",
73                                      ""),
74                               ver)
75                   else if(ver1[1L] <= "12")
76                        sprintf("macOS %s %s",
77                               switch(ver1[1L],
78                                      "11" = "Big Sur",
79                                      "12" = "Monterey"),
80                               ver)
81                   else
82                       sprintf("macOS %s", ver)
83               },
84               "SunOS" = {
85                   ver <- system('uname -r', intern = TRUE)
86                   paste("Solaris",
87                         strsplit(ver, ".", fixed = TRUE)[[1L]][2L])
88               },
89               uname)
90    } # using system('uname ..')
91    ## else NULL
92}
93
94sessionInfo <- function(package = NULL)
95{
96    z <- list()
97    z$R.version <- R.Version()
98    z$platform <- z$R.version$platform
99    if(nzchar(.Platform$r_arch))
100        z$platform <- paste(z$platform, .Platform$r_arch, sep = "/")
101    z$platform <- paste0(z$platform, " (", 8*.Machine$sizeof.pointer, "-bit)")
102    z$locale <- Sys.getlocale()
103    z$running <- osVersion
104    z$RNGkind <- RNGkind()
105    if(is.null(package)){
106        package <- grep("^package:", search(), value=TRUE)
107        # weed out environments which are not really packages
108        keep <- vapply(package, function(x) x == "package:base"
109                       || !is.null(attr(as.environment(x), "path")), NA)
110        package <- .rmpkg(package[keep])
111    }
112
113    ## no need to re-encode given what we extract.
114    pkgDesc <- lapply(package, packageDescription, encoding = NA)
115    if(length(package) == 0) stop("no valid packages were specified")
116    basePkgs <- sapply(pkgDesc,
117                       function(x) !is.null(x$Priority) && x$Priority=="base")
118    ## Hmm, see tools:::.get_standard_package_names()$base
119    z$basePkgs <- package[basePkgs]
120    if(any(!basePkgs)){
121        z$otherPkgs <- pkgDesc[!basePkgs]
122        names(z$otherPkgs) <- package[!basePkgs]
123    }
124    loadedOnly <- loadedNamespaces()
125    loadedOnly <- loadedOnly[!(loadedOnly %in% package)]
126    if (length(loadedOnly)) {
127        names(loadedOnly) <- loadedOnly
128        pkgDesc <- c(pkgDesc, lapply(loadedOnly, packageDescription))
129        z$loadedOnly <- pkgDesc[loadedOnly]
130    }
131    z$matprod <- as.character(options("matprod"))
132    es <- extSoftVersion()
133    z$BLAS <- as.character(es["BLAS"]) #drop name
134    z$LAPACK <- La_library()
135    l10n <- l10n_info()
136    if (!is.null(l10n["system.codepage"]))
137        z$system.codepage <- as.character(l10n["system.codepage"])
138    if (!is.null(l10n["codepage"]))
139        z$codepage <- as.character(l10n["codepage"])
140    class(z) <- "sessionInfo"
141    z
142}
143
144print.sessionInfo <- function(x, locale = TRUE,
145			      RNG = !identical(x$RNGkind, .RNGdefaults),
146			      ...)
147{
148    mkLabel <- function(L, n) {
149        vers <- sapply(L[[n]], function(x) x[["Version"]])
150        pkg <-  sapply(L[[n]], function(x) x[["Package"]])
151        paste(pkg, vers, sep = "_")
152    }
153
154    cat(x$R.version$version.string, "\n", sep = "")
155    cat("Platform: ", x$platform, "\n", sep = "")
156    if (!is.null(x$running)) cat("Running under: ",  x$running, "\n", sep = "")
157    cat("\n")
158    cat("Matrix products: ", x$matprod, "\n", sep = "")
159    blas <- x$BLAS
160    if (is.null(blas)) blas <- ""
161    lapack <- x$LAPACK
162    if (is.null(lapack)) lapack <- ""
163    if (blas == lapack && nzchar(blas))
164        cat("BLAS/LAPACK: ", blas, "\n", sep = "")
165    else {
166        if(nzchar(blas))   cat("BLAS:   ",   blas, "\n", sep = "")
167        if(nzchar(lapack)) cat("LAPACK: ", lapack, "\n", sep = "")
168    }
169    cat("\n")
170    if(RNG) {
171        cat("Random number generation:\n"
172          , "RNG:    ", x$RNGkind[1], "\n"
173          , "Normal: ", x$RNGkind[2], "\n"
174          , "Sample: ", x$RNGkind[3], "\n"
175          , "\n")
176    }
177    if(locale) {
178        cat("locale:\n")
179        print(strsplit(x$locale, ";", fixed=TRUE)[[1]], quote=FALSE, ...)
180        if (!is.null(x$system.codepage) && !is.null(x$codepage) &&
181            x$system.codepage != x$codepage)
182            cat("system code page: ", x$system.codepage, "\n", sep = "")
183        cat("\n")
184    }
185    cat("attached base packages:\n")
186    print(x$basePkgs, quote=FALSE, ...)
187    if(!is.null(x$otherPkgs)){
188        cat("\nother attached packages:\n")
189	print(mkLabel(x, "otherPkgs"), quote = FALSE, ...)
190    }
191    if(!is.null(x$loadedOnly)){
192        cat("\nloaded via a namespace (and not attached):\n")
193	print(mkLabel(x, "loadedOnly"), quote = FALSE, ...)
194    }
195    invisible(x)
196}
197
198##' From a list of packageDescription()s,
199##' construct string  "<p1>~<ver>, <p2>~<ver>, ..., <pn>~<ver>"
200toLatexPDlist <- function(pdList, sep = "~") {
201    if(length(ver <- vapply(pdList, `[[`, "", "Version"))) {
202	ver <- ver[sort(names(ver))]
203	paste(names(ver), ver, sep = sep, collapse = ", ")
204    } else ver
205}
206
207toLatex.sessionInfo <-
208    function(object, locale = TRUE,
209	     RNG = !identical(object$RNGkind, .RNGdefaults),
210	     ...)
211{
212    z <- c("\\begin{itemize}\\raggedright",
213	   paste0("  \\item ", object$R.version$version.string,
214		  ", \\verb|", object$R.version$platform, "|"),
215	   if(locale)
216	       paste0("  \\item Locale: \\verb|",
217		  gsub(";", "|, \\verb|", object$locale,  fixed=TRUE), "|"),
218	   paste0("  \\item Running under: \\verb|",
219		  gsub(";", "|, \\verb|", object$running, fixed=TRUE), "|"),
220	   if(RNG)
221	       paste0("  \\item Random number generation:"
222		    , "  \\item RNG:    \\verb|", object$RNGkind[1], "|"
223		    , "  \\item Normal: \\verb|", object$RNGkind[2], "|"
224		    , "  \\item Sample: \\verb|", object$RNGkind[3], "|"
225		      )
226         , paste0("  \\item Matrix products: ", object$matprod)
227           )
228    blas <- object$BLAS
229    if (is.null(blas)) blas <- ""
230    lapack <- object$LAPACK
231    if (is.null(lapack)) lapack <- ""
232
233    if (blas == lapack && nzchar(blas))
234        z <- c(z, paste0("  \\item BLAS/LAPACK: \\verb|", blas, "|"))
235    else {
236        if (nzchar(blas))
237            z <- c(z, paste0("  \\item BLAS:   \\verb|", blas, "|"))
238        if (nzchar(lapack))
239            z <- c(z, paste0("  \\item LAPACK: \\verb|", lapack, "|"))
240    }
241
242    z <- c(z, strwrap(paste("\\item Base packages: ",
243			    paste(sort(object$basePkgs), collapse = ", ")),
244                      indent = 2, exdent = 4))
245
246    if(length(o.ver <- toLatexPDlist(object$otherPkg)))
247        z <- c(z,
248               strwrap(paste("  \\item Other packages: ", o.ver),
249                       indent = 2, exdent = 4))
250    if(length(n.ver <- toLatexPDlist(object$loadedOnly)))
251        z <- c(z,
252               strwrap(paste("  \\item Loaded via a namespace (and not attached): ",
253			     n.ver),
254                       indent = 2, exdent = 4))
255    z <- c(z, "\\end{itemize}")
256    class(z) <- "Latex"
257    z
258}
259