initial commit
This commit is contained in:
parent
f967624953
commit
f129784a21
|
|
@ -0,0 +1,7 @@
|
|||
.DS_Store
|
||||
a.out
|
||||
|
||||
*.mod
|
||||
*.log
|
||||
|
||||
build/
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
/*******************************************************************************************
|
||||
*
|
||||
* raylib [core] example - Basic window
|
||||
*
|
||||
* Welcome to raylib!
|
||||
*
|
||||
* To test examples, just press F6 and execute raylib_compile_execute script
|
||||
* Note that compiled executable is placed in the same folder as .c file
|
||||
*
|
||||
* You can find all basic examples on C:\raylib\raylib\examples folder or
|
||||
* raylib official webpage: www.raylib.com
|
||||
*
|
||||
* Enjoy using raylib. :)
|
||||
*
|
||||
* Example originally created with raylib 1.0, last time updated with raylib 1.0
|
||||
*
|
||||
* Example licensed under an unmodified zlib/libpng license, which is an OSI-certified,
|
||||
* BSD-like license that allows static linking with closed source software
|
||||
*
|
||||
* Copyright (c) 2013-2023 Ramon Santamaria (@raysan5)
|
||||
*
|
||||
********************************************************************************************/
|
||||
|
||||
#include "raylib.h"
|
||||
|
||||
//------------------------------------------------------------------------------------
|
||||
// Program main entry point
|
||||
//------------------------------------------------------------------------------------
|
||||
int main(void)
|
||||
{
|
||||
// Initialization
|
||||
//--------------------------------------------------------------------------------------
|
||||
const int screenWidth = 800;
|
||||
const int screenHeight = 450;
|
||||
|
||||
InitWindow(screenWidth, screenHeight, "raylib [core] example - basic window");
|
||||
|
||||
SetTargetFPS(60); // Set our game to run at 60 frames-per-second
|
||||
//--------------------------------------------------------------------------------------
|
||||
|
||||
// Main game loop
|
||||
while (!WindowShouldClose()) // Detect window close button or ESC key
|
||||
{
|
||||
// Update
|
||||
//----------------------------------------------------------------------------------
|
||||
// TODO: Update your variables here
|
||||
//----------------------------------------------------------------------------------
|
||||
|
||||
// Draw
|
||||
//----------------------------------------------------------------------------------
|
||||
BeginDrawing();
|
||||
|
||||
ClearBackground(RAYWHITE);
|
||||
|
||||
DrawText("Congrats! You created your first window!", 190, 200, 20, LIGHTGRAY);
|
||||
|
||||
EndDrawing();
|
||||
//----------------------------------------------------------------------------------
|
||||
}
|
||||
|
||||
// De-Initialization
|
||||
//--------------------------------------------------------------------------------------
|
||||
CloseWindow(); // Close window and OpenGL context
|
||||
//--------------------------------------------------------------------------------------
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <unistd.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <netinet/in.h>
|
||||
#include <netdb.h>
|
||||
#include <arpa/inet.h>
|
||||
#include <err.h>
|
||||
|
||||
char response[] = "HTTP/1.1 200 OK\r\n"
|
||||
"Content-Type: text/html; charset=UTF-8\r\n\r\n"
|
||||
"<!DOCTYPE html>\r\n"
|
||||
"<html lang='en'>\r\n"
|
||||
"<head>\r\n"
|
||||
"<style>body {background-color: black;color: #ddd;} </style>\r\n"
|
||||
" <meta charset='UTF-8'>\r\n"
|
||||
" <meta http-equiv='X-UA-Compatible' content='IE=edge'>\r\n"
|
||||
" <meta name='viewport' content='width=device-width, initial-scale=1.0'>\r\n"
|
||||
" <title>Document</title>\r\n"
|
||||
"</head>\r\n"
|
||||
"<body>\r\n"
|
||||
" <h1>test</h1>\r\n"
|
||||
"</body>\r\n"
|
||||
"</html>";
|
||||
|
||||
int main()
|
||||
{
|
||||
int one = 1, client_fd;
|
||||
struct sockaddr_in svr_addr, cli_addr;
|
||||
socklen_t sin_len = sizeof(cli_addr);
|
||||
|
||||
int sock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||
if (sock < 0)
|
||||
err(1, "can't open socket");
|
||||
|
||||
int port = 8080;
|
||||
svr_addr.sin_family = AF_INET;
|
||||
svr_addr.sin_addr.s_addr = INADDR_ANY;
|
||||
svr_addr.sin_port = htons(port);
|
||||
|
||||
if (bind(sock, (struct sockaddr *)&svr_addr, sizeof(svr_addr)) == -1)
|
||||
{
|
||||
close(sock);
|
||||
err(1, "Can't bind");
|
||||
}
|
||||
|
||||
listen(sock, 5);
|
||||
while (1)
|
||||
{
|
||||
client_fd = accept(sock, (struct sockaddr *)&cli_addr, &sin_len);
|
||||
printf("got connection\n");
|
||||
|
||||
if (client_fd == -1)
|
||||
{
|
||||
perror("Can't accept");
|
||||
continue;
|
||||
}
|
||||
|
||||
write(client_fd, response, sizeof(response) - 1); /*-1:'\0'*/
|
||||
shutdown(client_fd, SHUT_WR);
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="UTF-8" />
|
||||
<meta http-equiv="X-UA-Compatible" content="IE=edge" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
|
||||
<title>MMO Testing Game</title>
|
||||
<style>
|
||||
input:invalid {
|
||||
border: 2px dashed black;
|
||||
}
|
||||
|
||||
input:valid {
|
||||
border: 2px solid black;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<header>
|
||||
<h1>MMO Testing Game</h1>
|
||||
</header>
|
||||
<main>
|
||||
<p>
|
||||
I wanted to create this design document to better define the style and
|
||||
what features will be in the testing game. The testing game is going to
|
||||
be a extremely simplified 3D MMORPG in the spirit of Runescape 2. An
|
||||
environment where players can move around the environment and chat with
|
||||
each other.
|
||||
</p>
|
||||
|
||||
<form method="post" action="/">
|
||||
<h5>Signup Form</h5>
|
||||
<label for="username">Username: (max length 32 characters)</label><br />
|
||||
<input
|
||||
required
|
||||
type="text"
|
||||
id="username"
|
||||
name="username"
|
||||
maxlength="32"
|
||||
value=""
|
||||
/><br />
|
||||
<label for="password"
|
||||
>Password: (Must be between 8 and 24 characters and include 1
|
||||
Lowercase Character, 1 Capital, 1 Number, and 1 Symbol)</label
|
||||
><br />
|
||||
<input
|
||||
required
|
||||
pattern="^(?=.*\d)(?=.*[a-z])(?=.*[A-Z])(?=.*[a-zA-Z]).{8,}$"
|
||||
minlength="8"
|
||||
maxlength="24"
|
||||
type="password"
|
||||
id="password"
|
||||
name="password"
|
||||
value=""
|
||||
/><br />
|
||||
<label for="appearance">Appearance:</label><br />
|
||||
<input
|
||||
required
|
||||
type="color"
|
||||
value="#000000"
|
||||
id="appearance"
|
||||
name="appearance"
|
||||
/>
|
||||
<br /><br />
|
||||
<button type="submit">Submit</button>
|
||||
</form>
|
||||
</main>
|
||||
</body>
|
||||
</html>
|
||||
Binary file not shown.
|
|
@ -0,0 +1,7 @@
|
|||
# Programming Language Project Fortran Implementation
|
||||
|
||||
[fortran-µhttpd (game website & webserver)](./www-f/README.md)
|
||||
|
||||
server (game backend)
|
||||
|
||||
client (game frontend / UI)
|
||||
|
|
@ -0,0 +1 @@
|
|||
# fortran mmo-project client
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#!/bin/sh
|
||||
gfortran -fno-range-check main.f90 raylib.f90 $(pkg-config --libs --cflags raylib) -o client
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
program main
|
||||
use iso_c_binding
|
||||
use raylib
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: screenWidth = 800
|
||||
integer(c_int) :: screenHeight = 450
|
||||
|
||||
type(camera3d), target :: camera
|
||||
type(c_ptr) :: camera_p
|
||||
|
||||
call init_window(screenWidth, screenHeight, "fortran client : raylib"//c_null_char)
|
||||
|
||||
camera%position = vector3(0.0_c_float, 2.0_c_float, 4.0_c_float) !Camera position
|
||||
camera%target = vector3(0.0_c_float, 2.0_c_float, 0.0_c_float) !Camera looking at point
|
||||
camera%up = vector3(0.0_c_float, -1.0_c_float, 0.0_c_float) !Camera up vector(rotation towards target)
|
||||
camera%fovy = 60.0_c_float !Camera field - of - view Y
|
||||
camera%projection = CAMERA_PERSPECTIVE !Camera projection type
|
||||
|
||||
camera_p = c_loc(camera)
|
||||
|
||||
call disable_cursor()
|
||||
call set_target_fps(60_c_int)
|
||||
|
||||
!Main game loop
|
||||
do while (.not. window_should_close()) ! Detect window close button or ESC key
|
||||
|
||||
call update_camera(camera_p, CAMERA_THIRD_PERSON) ! Update camera
|
||||
|
||||
call begin_drawing()
|
||||
call clear_background(RAYWHITE)
|
||||
|
||||
call begin_mode_3d(camera)
|
||||
call draw_plane(vector3(0.0_c_float, 0.0_c_float, 0.0_c_float), vector2(32.0_c_float, 32.0_c_float), LIGHTGRAY) !Draw ground
|
||||
call draw_cube(vector3(-16.0_c_float, 2.5_c_float, 0.0_c_float), 1.0_c_float, 5.0_c_float, 32.0_c_float, BLUE) !Draw a blue wall
|
||||
call draw_cube(vector3(16.0_c_float, 2.5_c_float, 0.0_c_float), 1.0_c_float, 5.0_c_float, 32.0_c_float, LIME) !Draw a green wall
|
||||
call draw_cube(vector3(0.0_c_float, 2.5_c_float, 16.0_c_float), 32.0_c_float, 5.0_c_float, 1.0_c_float, GOLD) !Draw a yellow wall
|
||||
|
||||
!Draw player cube
|
||||
call draw_cube(camera%target, 0.5_c_float, 0.5_c_float, 0.5_c_float, PURPLE)
|
||||
call draw_cube_wires(camera%target, 0.5_c_float, 0.5_c_float, 0.5_c_float, DARKPURPLE)
|
||||
call end_mode_3d()
|
||||
call end_drawing()
|
||||
|
||||
end do
|
||||
|
||||
call close_window() !Close window and OpenGL context
|
||||
|
||||
contains
|
||||
|
||||
end program main
|
||||
|
|
@ -0,0 +1,171 @@
|
|||
module raylib
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
|
||||
type, bind(c) :: vector2
|
||||
real(c_float) :: x
|
||||
real(c_float) :: y
|
||||
end type
|
||||
|
||||
type, bind(c) :: vector3
|
||||
real(c_float) :: x
|
||||
real(c_float) :: y
|
||||
real(c_float) :: z
|
||||
end type
|
||||
|
||||
type, bind(c) :: color
|
||||
integer(c_int8_t) :: r
|
||||
integer(c_int8_t) :: g
|
||||
integer(c_int8_t) :: b
|
||||
integer(c_int8_t) :: a
|
||||
end type
|
||||
|
||||
type(color) :: LIGHTGRAY = color(200, 200, 200, 255)
|
||||
type(color) :: GRAY = color(130, 130, 130, 255)
|
||||
type(color) :: DARKGRAY = color(80, 80, 80, 255)
|
||||
type(color) :: YELLOW = color(253, 249, 0, 255)
|
||||
type(color) :: GOLD = color(255, 203, 0, 255)
|
||||
type(color) :: ORANGE = color(255, 161, 0, 255)
|
||||
type(color) :: PINK = color(255, 109, 194, 255)
|
||||
type(color) :: RED = color(230, 41, 55, 255)
|
||||
type(color) :: MAROON = color(190, 33, 55, 255)
|
||||
type(color) :: GREEN = color(0, 228, 48, 255)
|
||||
type(color) :: LIME = color(0, 158, 47, 255)
|
||||
type(color) :: DARKGREEN = color(0, 117, 44, 255)
|
||||
type(color) :: SKYBLUE = color(102, 191, 255, 255)
|
||||
type(color) :: BLUE = color(0, 121, 241, 255)
|
||||
type(color) :: DARKBLUE = color(0, 82, 172, 255)
|
||||
type(color) :: PURPLE = color(200, 122, 255, 255)
|
||||
type(color) :: VIOLET = color(135, 60, 190, 255)
|
||||
type(color) :: DARKPURPLE = color(112, 31, 126, 255)
|
||||
type(color) :: BEIGE = color(211, 176, 131, 255)
|
||||
type(color) :: BROWN = color(127, 106, 79, 255)
|
||||
type(color) :: DARKBROWN = color(76, 63, 47, 255)
|
||||
type(color) :: WHITE = color(255, 255, 255, 255)
|
||||
type(color) :: BLACK = color(0, 0, 0, 255)
|
||||
type(color) :: BLANK = color(0, 0, 0, 0)
|
||||
type(color) :: MAGENTA = color(255, 0, 255, 255)
|
||||
type(color) :: RAYWHITE = color(245, 245, 245, 255)
|
||||
|
||||
type, bind(c) :: camera3d
|
||||
type(vector3) :: position
|
||||
type(vector3) :: target
|
||||
type(vector3) :: up
|
||||
real(c_float) :: fovy
|
||||
integer(c_int) :: projection
|
||||
end type
|
||||
|
||||
!Camera system modes
|
||||
integer(c_int) :: CAMERA_CUSTOM = 0
|
||||
integer(c_int) :: CAMERA_FREE = 1
|
||||
integer(c_int) :: CAMERA_ORBITAL = 2
|
||||
integer(c_int) :: CAMERA_FIRST_PERSON = 3
|
||||
integer(c_int) :: CAMERA_THIRD_PERSON = 4
|
||||
|
||||
!Camera projection
|
||||
integer(c_int) :: CAMERA_PERSPECTIVE = 0
|
||||
integer(c_int) :: CAMERA_ORTHOGRAPHIC = 1
|
||||
|
||||
interface
|
||||
|
||||
subroutine init_window(width, height, title) bind(c, name="InitWindow")
|
||||
import :: c_char
|
||||
import :: c_int
|
||||
integer(c_int), intent(in), value :: width
|
||||
integer(c_int), intent(in), value :: height
|
||||
character(c_char), dimension(*), intent(in) :: title
|
||||
end subroutine
|
||||
|
||||
function window_should_close() result(res) bind(c, name="WindowShouldClose")
|
||||
import :: c_bool
|
||||
logical(c_bool) :: res
|
||||
end function
|
||||
|
||||
subroutine close_window() bind(c, name="CloseWindow")
|
||||
end subroutine
|
||||
|
||||
subroutine clear_background(col) bind(c, name="ClearBackground")
|
||||
import :: color
|
||||
Type(color), intent(in), value :: col
|
||||
end subroutine
|
||||
|
||||
subroutine begin_drawing() bind(c, name="BeginDrawing")
|
||||
end subroutine
|
||||
|
||||
subroutine end_drawing() bind(c, name="EndDrawing")
|
||||
end subroutine
|
||||
|
||||
subroutine begin_mode_3d(camera) bind(c, name="BeginMode3D")
|
||||
import :: camera3d
|
||||
type(camera3d), intent(in), value :: camera
|
||||
end subroutine
|
||||
|
||||
subroutine end_mode_3d() bind(c, name="EndMode3D")
|
||||
end subroutine
|
||||
|
||||
subroutine set_target_fps(fps) bind(c, name="SetTargetFPS")
|
||||
import :: c_int
|
||||
integer(c_int), intent(in), value :: fps
|
||||
end subroutine
|
||||
|
||||
subroutine update_camera(camera_ptr, mode) bind(c, name="UpdateCamera")
|
||||
import :: c_ptr, c_int
|
||||
type(c_ptr) :: camera_ptr
|
||||
integer(c_int):: mode
|
||||
end subroutine update_camera
|
||||
|
||||
subroutine show_cursor() bind(c, name="ShowCursor")
|
||||
end subroutine show_cursor
|
||||
|
||||
subroutine hide_cursor() bind(c, name="HideCursor")
|
||||
end subroutine hide_cursor
|
||||
|
||||
subroutine EnableCursor() bind(c, name="EnableCursor")
|
||||
end subroutine EnableCursor
|
||||
|
||||
subroutine disable_cursor() bind(c, name="DisableCursor")
|
||||
end subroutine disable_cursor
|
||||
|
||||
subroutine draw_text(text, posX, posY, fontSize, col) bind(c, name="DrawText")
|
||||
import :: c_int
|
||||
import :: color
|
||||
import :: c_char
|
||||
character(c_char), dimension(*), intent(in) :: text
|
||||
integer(c_int), intent(in), value :: posX
|
||||
integer(c_int), intent(in), value :: posY
|
||||
integer(c_int), intent(in), value :: fontSize
|
||||
type(color), intent(in), value :: col
|
||||
end subroutine draw_text
|
||||
|
||||
subroutine draw_cube(position, width, height, length, col) bind(c, name="DrawCube")
|
||||
import :: vector3
|
||||
import :: c_float
|
||||
import :: color
|
||||
type(vector3), intent(in), value :: position
|
||||
real(c_float), intent(in), value :: width
|
||||
real(c_float), intent(in), value :: height
|
||||
real(c_float), intent(in), value :: length
|
||||
type(color), intent(in), value :: col
|
||||
end subroutine draw_cube
|
||||
|
||||
subroutine draw_cube_wires(position, width, height, length, col) bind(c, name="DrawCubeWires")
|
||||
import :: vector3
|
||||
import :: c_float
|
||||
import :: color
|
||||
type(vector3), intent(in), value :: position
|
||||
real(c_float), intent(in), value :: width
|
||||
real(c_float), intent(in), value :: height
|
||||
real(c_float), intent(in), value :: length
|
||||
type(color), intent(in), value :: col
|
||||
end subroutine draw_cube_wires
|
||||
|
||||
subroutine draw_plane(centerPos, size, col) bind(c, name="DrawPlane")
|
||||
import vector3
|
||||
import vector2
|
||||
import color
|
||||
type(vector3), intent(in), value :: centerPos
|
||||
type(vector2), intent(in), value :: size
|
||||
type(color), intent(in), value :: col
|
||||
end subroutine draw_plane
|
||||
end interface
|
||||
end module
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
# fortran-µhttpd (game website & webserver)
|
||||
|
||||
Fortran does not have any native way to connect to the internet. It cannot even create sockets of any kind.
|
||||
|
||||
This makes it an absolute nightmare to create a web server since you need to import sockets and tcp libraries from C, using the using the [use iso_c_binding feature](https://fortranwiki.org/fortran/show/iso_c_binding).
|
||||
|
||||
However, in the spirit of the challenge, I wanted to not have to resort to importing functions from another programming language as much as possible. Later when I create the client I would *have* to import libraries from C, but for this I could try and use "Fortran Only".
|
||||
|
||||
While reading this [old Fortran google groups question from 2009](https://groups.google.com/g/comp.lang.fortran/c/wL1xdnB1plk) the group suggested that the user just use [netcat](https://en.wikipedia.org/wiki/Netcat) and serve the Fortran program as if it were a cgi script.
|
||||
|
||||
This was a great idea because instead of needing to mess around with networking and making sure the functions and types imported corretly from C, I could just read and write to standard in/out and to files.
|
||||
|
||||
The downside of using `netcat` is that it uses unidirectional sockets. You would have to create a named pipe and do a bunch of redrieting to get it to work.
|
||||
|
||||
```sh
|
||||
mkfifo ncpipe
|
||||
nc -l 8080 0<ncpipe | ./fortran-µhttpd '../../common/html/index.html' 1>ncpipe
|
||||
```
|
||||
|
||||
It just doesnt seem all that clean to me. Additionally, it refused to stay open after running one message from the web client, so I gave up on that approach.
|
||||
|
||||
Somthing that does work and be a lot cleaner is [listen1](https://9fans.github.io/plan9port/man/man8/listen1.html) from [plan9port](https://9fans.github.io/plan9port/). This allows for the web browser to connect to the programs stdin, stdout, & stderr, and the program can read and write as a normal command line program.
|
||||
|
||||
```sh
|
||||
listen1 'tcp!*!8080' ./fortran-µhttpd
|
||||
```
|
||||
I next implemented the post handling. In www.f90, it checks to see if the header returning from the
|
||||
|
||||
I found a library to interface with the sqlite library I will store the username, password, and other information about.
|
||||
|
||||
The issue is that fortran does not have a built in cryptographic hash library nor is it in the stdlib, I did find a implementation of the [SM3](https://github.com/zoziha/SM3-Fortran/tree/main) hash which is cryptographically sound, and have used that.
|
||||
|
||||
If this were to be used in the real world I would prefer to use [bcrypt](https://en.wikipedia.org/wiki/Bcrypt) as it is the most common password hashing algorithm.
|
||||
|
||||
The implementation does not work well with existing systems since you have to convert from fortran strings to c strings and it returns an integer array of c strings which has to be converted back into fortran strings.
|
||||
|
||||
This is a horrible implementation from a security POV, since there is no easy way to sanitize the input, fortran certainly doesn't do that out of the box.
|
||||
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
program main
|
||||
use www
|
||||
use sqliteff
|
||||
use SM3_module, only: SM3
|
||||
use iso_varying_string
|
||||
use, intrinsic :: iso_c_binding, only: c_signed_char, c_size_t
|
||||
implicit none
|
||||
|
||||
character, dimension(:), allocatable :: form_data
|
||||
character(len=32) :: index_path
|
||||
character(len=128) :: db_path
|
||||
integer :: err, i, length
|
||||
logical :: exist
|
||||
|
||||
call getarg(1, index_path)
|
||||
index_path = trim(index_path)
|
||||
|
||||
call getarg(2, db_path)
|
||||
db_path = trim(db_path)
|
||||
|
||||
call request(form_data, length)
|
||||
|
||||
if (length .gt. 0) then
|
||||
call createDB(db_path)
|
||||
inquire(file="debug.log", exist=exist)
|
||||
if (exist) then
|
||||
open(12, file="debug.log", status="old", position="rewind", action="write")
|
||||
else
|
||||
open(12, file="debug.log", status="new", action="write")
|
||||
end if
|
||||
do i=1,length
|
||||
write(12, '(A)', advance="NO") form_data(i)
|
||||
end do
|
||||
write(12, '(A)')
|
||||
close(unit=12)
|
||||
call write_index(index_path)
|
||||
else
|
||||
call write_index(index_path)
|
||||
end if
|
||||
|
||||
if (allocated(form_data)) deallocate (form_data, stat=err)
|
||||
if (err /= 0) print *, "index_html: Deallocation request denied"
|
||||
|
||||
contains
|
||||
|
||||
subroutine createDB(db_path)
|
||||
character(len=128), intent(in) :: db_path
|
||||
type(SqliteDatabase_t) :: connection
|
||||
type(SqliteStatement_t) :: statement
|
||||
type(VARYING_STRING) :: remaining
|
||||
integer :: status
|
||||
|
||||
status = sqliteff_open(db_path, connection)
|
||||
|
||||
status = sqliteff_prepare( &
|
||||
connection, &
|
||||
var_str("CREATE TABLE users (identifier INTEGER PRIMARY KEY ASC, " &
|
||||
// "username TEXT, password TEXT, apperance TEXT, x_pos INTEGER, " &
|
||||
// "y_pos INTEGER, last_login INTEGER, created INTEGER);"), &
|
||||
statement, &
|
||||
remaining)
|
||||
|
||||
if (status .eq. SQLITE_OK) then
|
||||
status = sqliteff_step(statement)
|
||||
status = sqliteff_finalize(statement)
|
||||
status = sqliteff_close(connection)
|
||||
end if
|
||||
|
||||
end subroutine createDB
|
||||
|
||||
subroutine addUser(db_path, username, password, appearance)
|
||||
character(len=128), intent(in) :: db_path
|
||||
character(len=24), intent(in) :: username
|
||||
character(len=24), intent(in) :: password
|
||||
character(len=8), intent(in) :: appearance
|
||||
character(len=32) :: encrypted_password
|
||||
|
||||
type(SqliteDatabase_t) :: connection
|
||||
type(VARYING_STRING) :: errmsg
|
||||
integer :: status
|
||||
integer(8) :: created
|
||||
character(len=32) :: created_str
|
||||
|
||||
integer(c_signed_char) :: dgst(32)
|
||||
integer(c_signed_char) :: msg(25)
|
||||
|
||||
msg = transfer(password, msg)
|
||||
call SM3(msg, 25_c_size_t, dgst)
|
||||
|
||||
write (encrypted_password, *) dgst
|
||||
encrypted_password = adjustl(encrypted_password)
|
||||
|
||||
created = time()
|
||||
write (created_str, *) created
|
||||
created_str = adjustl(created_str)
|
||||
|
||||
status = sqliteff_open(db_path, connection)
|
||||
|
||||
status = sqliteff_exec( &
|
||||
connection, &
|
||||
'INSERT INTO users (username, password, apperance, x_pos, y_pos, last_login, created) &
|
||||
VALUES ("'//username//'", "'//encrypted_password//'", "#'//appearance//'", &
|
||||
0, 0, 0, '//created_str//'");', &
|
||||
errmsg)
|
||||
|
||||
status = sqliteff_close(connection)
|
||||
|
||||
end subroutine addUser
|
||||
|
||||
end program main
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
author = "zongor"
|
||||
copyright = "Copyright 2023, zongor"
|
||||
license = "license"
|
||||
maintainer = "admin@alfrescocavern.com"
|
||||
name = "fortran-micro-httpd"
|
||||
version = "0.1.0"
|
||||
[build]
|
||||
auto-examples = true
|
||||
auto-executables = true
|
||||
auto-tests = false
|
||||
module-naming = false
|
||||
[install]
|
||||
library = false
|
||||
[fortran]
|
||||
implicit-external = false
|
||||
implicit-typing = false
|
||||
source-form = "free"
|
||||
[dependencies]
|
||||
iso_varying_string.git = "https://gitlab.com/everythingfunctional/iso_varying_string"
|
||||
sqliteff.git = "https://gitlab.com/everythingfunctional/sqliteff"
|
||||
sm3-fortran.git = "https://github.com/zoziha/SM3-Fortran"
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
module www
|
||||
use iso_fortran_env
|
||||
implicit none
|
||||
private
|
||||
character(len=1024) :: buffer
|
||||
|
||||
public :: response_header, request, write_index
|
||||
contains
|
||||
|
||||
subroutine response_header(length)
|
||||
integer, intent(in) :: length
|
||||
|
||||
write (output_unit, '(A)') "HTTP/1.1 200 OK"
|
||||
write (output_unit, '(A)') "Server: fortran-µhttpd"
|
||||
write (output_unit, '(A)') "Content-Type: text/html; charset=UTF-8"
|
||||
write (output_unit, '(A)', advance='no') "Content-length: "
|
||||
write (output_unit, *) length
|
||||
write (output_unit, *)
|
||||
end subroutine response_header
|
||||
|
||||
subroutine request(post_content, post_content_length)
|
||||
character, dimension(:), allocatable, intent(out) :: post_content
|
||||
integer, intent(out) :: post_content_length
|
||||
character(len=:), allocatable :: client_request
|
||||
integer :: content_length, err, isize, cr_index, i
|
||||
|
||||
client_request = ''
|
||||
post_content_length = 0
|
||||
read_client_request: do
|
||||
read (input_unit, iostat=err, fmt='(a)', advance='no', size=isize) buffer
|
||||
if (isize .eq. 0) exit read_client_request
|
||||
|
||||
cr_index = index(buffer(:isize), "Content-Length: ", back=.true.)
|
||||
if (cr_index .ne. 0) then
|
||||
cr_index = index(buffer(:isize), ": ")
|
||||
read (buffer(cr_index + 2:isize), *) content_length
|
||||
end if
|
||||
|
||||
client_request = client_request//buffer(:isize)//new_line('(A)')
|
||||
end do read_client_request
|
||||
|
||||
if (content_length .gt. 0) then
|
||||
post_content_length = content_length
|
||||
allocate (post_content(content_length))
|
||||
do i = 1, content_length
|
||||
read (input_unit, iostat=err, fmt='(a)', advance='no', size=isize) post_content(i)
|
||||
end do
|
||||
end if
|
||||
end subroutine request
|
||||
|
||||
subroutine write_index(filename)
|
||||
character(len=32), intent(in) :: filename
|
||||
character, dimension(:), allocatable :: index_html
|
||||
integer :: filesize, err, i
|
||||
|
||||
open (unit=11, file=filename, status='old', access='stream')
|
||||
inquire (unit=11, size=filesize)
|
||||
|
||||
allocate (index_html(filesize))
|
||||
|
||||
do i = 1, filesize
|
||||
read (11, pos=i) index_html(i)
|
||||
end do
|
||||
close (unit=11)
|
||||
|
||||
call response_header(filesize)
|
||||
write (output_unit, *) index_html
|
||||
|
||||
if (allocated(index_html)) deallocate (index_html, stat=err)
|
||||
if (err /= 0) print *, "index_html: Deallocation request denied"
|
||||
end subroutine write_index
|
||||
|
||||
end module www
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#!/bin/sh
|
||||
listen1 'tcp!*!1234' ./build/gfortran_D153B38149EACCAC/app/fortran-micro-httpd ../../common/html/index.html ../../common/sql/test.db3
|
||||
Loading…
Reference in New Issue