diff options
Diffstat (limited to 'ctftilde')
| -rw-r--r-- | ctftilde/src/guile/ctftilde/main-site.scm | 84 | ||||
| -rw-r--r-- | ctftilde/src/guile/ctftilde/users.scm | 53 |
2 files changed, 103 insertions, 34 deletions
diff --git a/ctftilde/src/guile/ctftilde/main-site.scm b/ctftilde/src/guile/ctftilde/main-site.scm index 1598ff3..fc9e6c2 100644 --- a/ctftilde/src/guile/ctftilde/main-site.scm +++ b/ctftilde/src/guile/ctftilde/main-site.scm @@ -93,22 +93,68 @@ and minimalism. Besides this, you can run your own website or Gemini capsule.") package manager & operating system. And it lets the users benefit from this tooling as well!") - (h2 "What to do?") + (h2 "Unconvinced?") (p "If you're not yet sure you want to join, take time to browse other user's tilde websites/capsules and see how they spend time here. You might also want to familiarize yourself with GNU Guix. Once you're ready, jump to our -registration page.") +registration page. You might also want to read our short \"First Steps\" +article.") (ul (li (a (@ (href "https://guix.gnu.org/")) "GNU Guix website")) (li (a (@ (href "https://ctftilde.koszko.org/registration")) - "Registration page"))) + "Registration page")) + (li (a (@ (href "https://ctftilde.koszko.org/first-steps")) + "First Steps"))) (h2 "Our users' blogs") + (p "(please send an email to admin@ctftilde.koszko.org if you want to have +your blog listed here)") (ul (li (a (@ (href "./~abdul")) "~abdul")))))) +(cant:define-endpoint %endset first-steps + ("first-steps") '() + (contents->html + '((h1 "First steps") + (p "So, you've made an account through the registration page and can now +connect via SSH. You're surely wondering where to put your HTML pages to have +them served, etc…") + (ul + (li (a (@ (href "https://ctftilde.koszko.org/registration")) + "Registration page"))) + + (h2 "HTTP user directory") + (p "Your very own HTTP directory is at") + (pre "/srv/http/users/$YOUR_USERNAME/") + (p "It is served by Apache. Whatever you put there, will be viewable at") + (pre "https://ctftilde.koszko.org/~$YOUR_USERNAME/") + (p "Btw, if you like simple and lean web pages, feel free to load the +minimal CC0-licensed stylesheet at") + (pre "https://ctftilde.koszko.org/resources/ctftilde.css") + (p "into your HTML documents :)") + + (h2 "Gemini user directory") + (p "Don't you also feel that \"Web\" is sometimes too much? Wouldn't you +love to let others view your blog (or whatever you publish) using a friendlier +technology? Here's how to: put your files under") + (pre "/srv/gemini-users/$YOUR_USERNAME/") + (p "They will immediately become available under") + (pre "gemini://ctftilde.koszko.org/~$YOUR_USERNAME") + (p "Make sure not to miss gemtext, the minimal markup language desined for +Gemini.") + (ul + (li (a (@ (href "https://geminiprotocol.net/")) + "Project Gemini website")) + (li (a (@ (href "gemini://geminiprotocol.net/")) + "Project Gemini capsule (over the gemini protocol)"))) + + (h2 "Cron") + (p "We've made the effort to have a working") + (pre "crontab") + (p "command. Use it as you would on any GNU+Linux distro!")))) + (define query-param-regex (make-regexp "^([^=]+)(=(.*))?")) @@ -172,7 +218,8 @@ registration page.") (and (not (regexp-exec start-with-lowercase-regex username)) "Username must start with a lowercase letter.")) ,(lambda _ - (and (false-if-exception (getpwnam username)) + (and (false-if-exception (getpwnam (format #f "ctftilde-~a" + username))) "This username is unavailable.")))) ("password" @@ -192,7 +239,7 @@ registration page.") (and (not (regexp-exec email-regex email)) "Provided email is not valid."))))))) -(cant:define-endpoint %endset main-page +(cant:define-endpoint %endset registration-page ("registration") '() (define legal-POST? @@ -216,21 +263,24 @@ registration page.") (cond ((and legal-POST? (eq? '() params-mistakes)) - (write (list (format #f "ctftilde-~a" (assoc-ref params "username")) - (encrypt-password (assoc-ref params "password"))) - (%daemon-write-port)) + (let ((username (format #f "ctftilde-~a" (assoc-ref params "username")))) - (contents->html - (match (read (%daemon-read-port)) + (write (list username (encrypt-password (assoc-ref params "password"))) + (%daemon-write-port)) + + (contents->html + (match (read (%daemon-read-port)) - ('(ok) - `((h1 "Done") - (p ,(format #f "Try connecting via ssh to ~a@ctftilde.koszko.org." - (assoc-ref params "username"))))) + ('(ok) + `((h1 "Done") + (p ,(format #f "Try connecting via ssh to ~a@ctftilde.koszko.org." + username)) + (p "Also, please don't abuse our server's resources. Let others use +the platform, too :)"))) - (_ - `((h1 "Ooops!") - (p "Something went wrong X(")))))) + (_ + `((h1 "Ooops!") + (p "Something went wrong X("))))))) (else (contents->html diff --git a/ctftilde/src/guile/ctftilde/users.scm b/ctftilde/src/guile/ctftilde/users.scm index 3d17362..aaaae51 100644 --- a/ctftilde/src/guile/ctftilde/users.scm +++ b/ctftilde/src/guile/ctftilde/users.scm @@ -6,6 +6,7 @@ #:use-module ((ice-9 exceptions) #:select (raise-exception with-exception-handler)) #:use-module ((ice-9 match) #:select (match)) + #:use-module ((ice-9 regex) #:select (match:substring)) #:use-module ((system repl debug) #:select (terminal-width)) @@ -61,6 +62,18 @@ (dynamic-wind noop loop (cut closedir dir)))) +(define ctftilde-user-regex + (make-regexp "^ctftilde-(.*)")) + +(define (strip-ctftilde username) + (match (regexp-exec ctftilde-user-regex username) + + (#f + username) + + ((= (cut match:substring <> 1) stripped-username) + stripped-username))) + (define (*delete-user username) @@ -74,8 +87,10 @@ (false-if-exception (delete-file creation-file)) (system* "userdel" "-rf" username) - (system* "rm" "-rf" (string-append "/srv/gemini-users/" username)) - (system* "rm" "-rf" (string-append "/srv/http-users/" username)) + (system* "rm" "-rf" (string-append "/srv/gemini-users/" + (strip-ctftilde username))) + (system* "rm" "-rf" (string-append "/srv/http-users/" + (strip-ctftilde username))) (sync) (false-if-exception (delete-file deletion-file)) (sync))) @@ -94,21 +109,25 @@ (make-regexp "^[a-zA-Z][a-zA-Z0-9-]*$")) (define* (*make-user username encrypted-password #:optional recreated-user-uid) + (define home-dir + (string-append "/home/ctftilde/" (strip-ctftilde username))) + (define (add-user) - (when (> (apply system* - `("useradd" - "--shell" "/run/current-system/profile/bin/bash" - "--home-dir" ,(string-append "/home/ctftilde/" username) - "--create-home" - ,@(or (and=> recreated-user-uid - (compose (cut list "--uid" <>) - number->string)) - '()) - "--gid" "hackers" - "-p" ,encrypted-password - ,username)) - 0) - (raise-exception "User could not be added."))) + (if (> (apply system* + `("useradd" + "--shell" "/run/current-system/profile/bin/bash" + "--home-dir" ,home-dir + "--create-home" + ,@(or (and=> recreated-user-uid + (compose (cut list "--uid" <>) + number->string)) + '()) + "--gid" "hackers" + "-p" ,encrypted-password + ,username)) + 0) + (raise-exception "User could not be added.") + (chmod home-dir #o700))) (define (add-user-files) (define user @@ -116,7 +135,7 @@ (define (make-user-file path-format what) (define path - (format #f path-format username)) + (format #f path-format (strip-ctftilde username))) (unless (file-exists? path) (match what |