1. # The Kernel class and its methods, underlying $*KERNEL, are a work in progress.
  2. # It is very hard to capture data about a changing universe in a stable API.
  3. # If you find errors for your hardware or OS distribution, please report them
  4. # with the values that you expected and how to get them in your situation.
  5. class Kernel does Systemic {
  6. has Str $.release;
  7. has Str $!hardware;
  8. has Str $!arch;
  9. has Int $!bits;
  10. sub uname($opt) {
  11. state $has_uname = "/bin/uname".IO.s || "/usr/bin/uname".IO.s;
  12. $has_uname ?? qqx/uname $opt/.chomp !! 'unknown';
  13. }
  14. submethod BUILD(:$!auth = "unknown" --> Nil) { }
  15. method name {
  16. $!name //= do {
  17. given $*DISTRO.name {
  18. when 'mswin32' {
  19. 'win32'
  20. }
  21. default {
  22. lc uname '-s';
  23. }
  24. }
  25. }
  26. }
  27. method version {
  28. $!version //= Version.new( do {
  29. given $*DISTRO.name {
  30. when 'freebsd' {
  31. uname '-r'; # -K -U not introduced until 10.0
  32. }
  33. when 'macosx' {
  34. my $unamev = uname '-v';
  35. $unamev ~~ m/^Darwin \s+ Kernel \s+ Version \s+ (<[\d\.]>+)/
  36. ?? ~$0
  37. !! $unamev.chomp;
  38. }
  39. default {
  40. given $.name {
  41. when 'linux' {
  42. # somewhat counter-intuitively the '-r' is what
  43. # most people think of the kernel version
  44. uname '-r';
  45. }
  46. default {
  47. uname '-v';
  48. }
  49. }
  50. }
  51. }
  52. } );
  53. }
  54. method release {
  55. $!release //= do {
  56. given $*DISTRO.name {
  57. when any <openbsd netbsd dragonfly> { # needs adapting
  58. uname '-r';
  59. }
  60. default {
  61. uname '-v';
  62. }
  63. }
  64. }
  65. }
  66. method hardware {
  67. $!hardware //= do {
  68. given $*DISTRO.name {
  69. default {
  70. uname '-m';
  71. }
  72. }
  73. }
  74. }
  75. method arch {
  76. $!arch //= do {
  77. given $*DISTRO.name {
  78. when 'raspbian' {
  79. uname '-m';
  80. }
  81. default {
  82. uname '-p';
  83. }
  84. }
  85. }
  86. }
  87. method archname {
  88. self.hardware ~ '-' ~ self.name
  89. }
  90. method bits {
  91. $!bits //= $.hardware ~~ m/_64|w|amd64/ ?? 64 !! 32; # naive approach
  92. }
  93. has @!signals; # Signal
  94. method signals (Kernel:D:) {
  95. once {
  96. my @names;
  97. if self.name eq 'win32' {
  98. # These are the ones libuv emulates on Windows.
  99. @names = flat "", <INT BREAK HUP WINCH>;
  100. } else {
  101. @names = flat "", qx/kill -l/.words;
  102. @names.splice(1,1) if @names[1] eq "0"; # Ubuntu fudge
  103. @names.=map({.uc}) if $*KERNEL.name eq 'dragonfly';
  104. }
  105. for Signal.^enum_value_list -> $signal {
  106. my $name = substr($signal.key,3);
  107. if @names.first( * eq $name, :k ) -> $index {
  108. @!signals[$index] = $signal;
  109. }
  110. }
  111. }
  112. @!signals
  113. }
  114. has %!signals_by_Str;
  115. proto method signal (|) { * }
  116. multi method signal(Kernel:D: Str:D $signal --> Int:D) {
  117. once {
  118. %!signals_by_Str =
  119. @.signals.pairs.grep(*.value.defined).map({~$_.value => +.key});
  120. }
  121. %!signals_by_Str{$signal} // %!signals_by_Str{"SIG$signal"} // Int;
  122. }
  123. has %!signals_by_Signal;
  124. multi method signal(Kernel:D: Signal:D $signal --> Int:D) {
  125. once {
  126. %!signals_by_Signal =
  127. @.signals.pairs.grep(*.value.defined).map({~$_.value.WHICH => +.key});
  128. }
  129. %!signals_by_Signal{$signal.WHICH} // Int;
  130. }
  131. multi method signal(Kernel:D: Int:D $signal --> Int:D) { $signal }
  132. }
  133. Rakudo::Internals.REGISTER-DYNAMIC: '$*KERNEL', {
  134. PROCESS::<$KERNEL> := Kernel.new;
  135. }